12

The problem is that you defined the Graph using M syntax and not Combinatorica syntax. For your example you should do: g = Combinatorica`Graph[{{{1,2}},{{2,3}}}, {1,2,3}] Combinatorica`Graph[{{{1, 2}}, {{2, 3}}}, {1, 2, 3}] Then, you can use the Combinatorica functions: code = Combinatorica`LabeledTreeToCode[g] Combinatorica`CodeToLabeledTree[code] {...


12

FindShortestPath supports two methods "BellmanFord" and "Dijkstra" and it works on normal non-combinatorica Graphs.


10

You'll want to manipulate $ContextPath. The following will do: removeCombinatorica[] := ( oldContextPath = $ContextPath; $ContextPath = DeleteCases[$ContextPath, "Combinatorica`"]; ) readdCombinatorica[] := ($ContextPath = oldContextPath;) Then you can call removeCombinatorica[] before whatever you want to ignore Combinatorica, and readdCombinatorica[] ...


10

I had an old program lying around that will generate all realizations of a degree sequence. The first vertex will have degree equal to the first element in the input list, the 2nd degree equal to the 2nd element, and so on. The program requires my IGraph/M package for graphicality testing. For details on how it works, see http://bolyai.cs.elte.hu/egres/tr/...


9

GraphComputation`GraphJoin GraphComputation`GraphJoin[PathGraph[{a, b}], PathGraph[{c, d, e}], VertexLabels -> "Name", ImagePadding -> 10, GraphLayout -> "MultipartiteEmbedding"] This undocumented function works in both version 9.0 and version 11.3.


9

In general, if we first use GraphAutomorphismGroup to find the automorphism group of a graph, it is not hard to figure out if it acts transitively on vertices, edges, arcs, pairs of vertices at distance $k$, or any other objects. For example, to test if a graph g is arc-transitive: test if Complement[Join[EdgeList[g], Reverse /@ EdgeList[g]], ...


7

Apparently, they killed it off without making an equivalent, so you'd have to re-implement an algorithm. documentation link is here: Upgrading from: Combinatorica In some cases, parameterized variants have not yet been implemented in the Wolfram System, but a subset can be found in GraphData. ... So you'll have to make your own. This should work ...


7

The type of a permutation of length $n$ is $\{\lambda_1, \lambda_2, \ldots, \lambda_n\}$ where $\lambda_i$ is the number of cycles of length $i$. Therefore, the number of permutations of $\{1, 2, 3, 4, 5, 6\}$ that have two 1-cycles and two 2-cycles is NumberOfPermutationsByType[{2, 2, 0, 0, 0, 0}] (* 45 *) The best reference for Combinatorica is Steven ...


7

The function you reference still works fine, but it is part of the Combinatorica package. You need to load the package first, and work with Combinatorica's own graph datatype. Combinatorica precedes Mathematica's built-in graph datatype by many years, and is not interoperable with it. That said, it is relatively easy to implement an equivalent function for ...


7

IGraph/M 0.3.111 now has fast functions to test for all of these. Please look under Isomorphism -> Properties related to the automorphism group in the documentation. Regular: IGRegularQ Vertex transitive: IGVertexTransitiveQ. Edge transitive: IGEdgeTransitiveQ. Strongly regular: IGStronglyRegularQ. Distance regular: IGDistanceRegularQ. Distance transitive: ...


7

The IGraph/M package has an implementation of this. Example: << IGraphM` g = RandomGraph[{10, 20}] Compute the chromatic number: IGChromaticNumber[g] (* 4 *) Compute a minimum colouring: IGMinimumVertexColoring[g] (* {3, 1, 4, 2, 2, 4, 1, 3, 1, 2} *) Visualize it: IGVertexMap[ColorData[97], VertexStyle -> IGMinimumVertexColoring, Graph[...


6

You can find the code for the function in the file Combinatorica.m: nb = NotebookOpen[ToFileName[{$InstallationDirectory, "AddOns", "Packages", "Combinatorica"}, "Combinatorica.m"]]; NotebookFind[nb, "ListGraphs[n_Integer?Positive, m_Integer]"]


6

Assuming there is a Method other than "AllTours" that doesn't break if one point doesn't obey the triangle inequality, introduce a special point that has a distance 0 to all other points: points = {{-0.9, -0.89}, {.99, .97}, {0.1, .0}, magicPoint}; d[args__] /; FreeQ[{args}, magicPoint] := EuclideanDistance[args] d[__] = 0; FindShortestTour[points, ...


5

It is hard to explain your DualPartition code as it does not seem to work on the Young tableaux generated by the Combinatorica package. Let's try to write something ourselves. Assuming DualPartitioncalculates a conjugate tableau this could be written as follows: Needs["Combinatorica`"] The Tableau function generates Young tableaux: Tableaux[5] (* {{{1, 2,...


5

I hope the following is helpful: Firstly, consider this example: gr = System`Graph[{1 <-> 2, 2 <-> 3, 3 <-> 4, 3 <-> 5}]; sysm = System`AdjacencyMatrix[gr]; com = Combinatorica`FromAdjacencyMatrix[Normal@sysm]; aut = Combinatorica`Automorphisms[com]; ex = System`Graph[EdgeList[gr], VertexLabels -> Table[j -> Placed[#[[j]],...


5

FromAdjacencyMatrix construct combinatorica graph. Subgraph and HighglightGraph accept system graph object. Instead of loading Combinatorica package, you can just create graph from matrix by using AdjacencyGraph: gr = AdjacencyGraph[BB] Then Subgraph should work fine with it: Subgraph[gr, {1, 2}]


5

The presently Accepted solution is quite slow, at least on long lists. We can improve performance of this brute-force algorithm by orders of magnitude using numeric vector operations. Consider: f1[a_] /; VectorQ[a, IntegerQ] := Sum[Tr @ Clip[a[[i]] ~Subtract~ Drop[a, i], {0, 1}], {i, Length@a}] f1[a_List] := f1 @ Ordering @ a Compared to myinversions ...


5

For those who are facing a similar problem, there is a beautiful package xTras which gives all possible contractions taking into account the symmetries of the tensors. The command is AllContractions; have a look here arxiv.org/1308.3493


5

Although xTras package is everything you need, I made a function (just for fun) that finds all the contraction of the product of 2-ranked tensors. It uses sort of bruteforce combinatorics, so it will be deadly slow on a large number of tensors. However, 3-5 tensors work just fine. NiceTensor[ilst_,names_]:=Inner[Subscript[#2,#1]&, StringJoin[ToString/@#]...


5

4X4 adjacency matrices: am = Tuples[{0, 1}, {4, 4}]; 4X4 adjacency matrices with no self-loops: simpleam = DeleteDuplicates[(1 - IdentityMatrix[4]) # & /@ am]; Adjacency matrices for undirected graphs on 4 nodes: undirectedam = Select[# == Transpose@# &]@simpleam; Adjacency matrices for graphs with vertex degree sequence {1,1,2,2}: vdegree1122am = ...


4

Something like this? myinversions[list_] := Select[ Subsets[Range[Length[list]], {2}] , list[[#[[1]]]] > list[[#[[2]]]] & ] // Length Verify the same result as builtin Inversions for a permutation Needs["Combinatorica`"] And @@ (Inversions[#] == myinversions[#] & /@ Permutations[Range[5]]) True myinversions[{1, 4, 2, 5, 2,...


4

There are short description and the definition of the Tableaux: Quiet@Needs["Combinatorica`"]; ?? Tableaux Tableaux[p] constructs all tableaux having a shape given by integer partition p. Attributes[Tableaux] = {Protected} Tableaux[s_List] := Module[{t = LastLexicographicTableau[s]}, Table[t = NextTableau[t], {NumberOfTableaux[s]}]] Tableaux[...


4

You can use CycleIndexPolynomial like so: CycleIndexPolynomial[ GraphAutomorphismGroup@GridGraph[{3, 3}], Array[Subscript[s, #] &, 4] ] $$ \frac{s_1^9}{8}+\frac{1}{2} s_2^3 s_1^3+\frac{1}{8} s_2^4 s_1+\frac{1}{4} s_4^2 s_1 $$


4

Internal`PartitionRagged[{a, b, c, d, e}, #] & /@ Flatten[Permutations /@ IntegerPartitions[5], 1] About Internal`PartitionRagged: I have read about it here.


4

Without loading any packages: g = RandomGraph[{30, 60}] ResourceFunction["ChromaticNumber"][g]


4

The function FindProperColorings is now in the Wolfram Function Repository, and it lists all the proper k-colorings of a graph. https://resources.wolframcloud.com/FunctionRepository/resources/FindProperColorings


4

Please see Computational Discrete Mathematics by Pemmaraju and Skiena, pages 106 and 107. DerangementQ[p_?PermutationListQ]:= !(Apply[Or,Map[(#===p[[#]])&,Range[Length[p]]]]) NumberOfDerangements[0] = 1; NumberOfDerangements[n_Integer?Positive] := Block[{$RecursionLimit = Infinity}, n*NumberOfDerangements[n - 1] + (-1)^n] Derangements[0] = {{}}; ...


4

GroupOrbits[CyclicGroup[5], {{1, 1, 2, 3, 3}}, Permute] {{{1, 1, 2, 3, 3}, {1, 2, 3, 3, 1}, {2, 3, 3, 1, 1}, {3, 1, 1, 2, 3}, {3, 3, 1, 1, 2}}}


3

Option 1 f[list_] := With[{part = Flatten[Permutations /@ IntegerPartitions[Length[list]], 1]}, Table[ First@Last@ Reap[FoldList[(Sow[First[#]]; Last[#]) &@*TakeDrop, list, p]] , {p, part}] ] f[{a, b, c, d, e}] // MatrixForm Option 2 PartitionRagged[vec_, lens_] := MapThread[vec[[#1 ;; #2]] &, With[{a = Accumulate[...


3

Possible partitions for a list with 5 elements: n = 5; Union@Select[Tuples[#, Length@#], Total@# == n &] & /@ IntegerPartitions[n] // Sort // MatrixForm


Only top voted, non community-wiki answers of a minimum length are eligible