Tag Info

New answers tagged

1

Reap[ lst //. {f___, PatternSequence["(", a__?(FreeQ["(" | ")"]), ")"], l___} :> (Sow[{Length[{f}] + 1, Length[{f}] + Length[{a}] + 2, Count[{a}, Except[Null]]}]; {f, Null, a, Null, l} ); ] // Last // Last // Reverse {{1, 13, 5}, {4, 12, 3}, {9, 11, 1}, {5, 7, 1}}


1

Here is a modified code from this post, where I only show the code for match, and the other (helper) functions should be taken from that post verbatim: ClearAll[match]; match[l_List] := withInfiniteIteration@match[toLL[enumerate@l], ll[], ll[]]; match[ll[{"(", p_}, tail_ll], accum_, res_] := match[tail, ll[{p, 0}, accum], res]; match[ll[{")", pc_}, ...


1

I guess this is more of the StackOverflow answer, but this is how I would do it (using Javascript, I hope the syntax isn't too confusing) var lst = ["(", "(", "(", ")", "(", ")", ")", ")"]; var pairs = []; for(i=0;i<lst.length;i++){ var matched = []; if(lst[i]==")"){ for(y=i;y>0;y--){ if(lst[y]=="(" && ...


12

This one returns the pairs in the order they get closed: Thread[{lst, Range@Length@lst}] //. {h___, {"(", i_}, {")", j_}, t___} :> {h, t, {i, j}} (* {{3, 4}, {5, 6}, {2, 7}, {1, 8}} *) If other characters appear in the list they can be filtered out with Cases before doing the replacement: lst = Characters["((()(a)))"]; Cases[Thread[{lst, ...


4

Should be a comment, but you asked me to explain this solution: lst = {"(", "(", "(", ")", "(", ")", ")", ")"} StringPosition[StringJoin@lst, RegularExpression@"(?P<0>\\(([^\\(\\)]|(?P>0))*\\))"] (* => {{1, 8}, {2, 7}, {3, 4}, {5, 6}} *) Here, I use recursive pattern matching that is available in PCRE library, that is built into Mathematica's ...


0

You can also use repeated replacement 1,3) The first two rules handle leading zeros, the first one handles several leading zeros and the second one handles a single leading zero.: cleanVector[v_]:=v//.{ {0, x:0___,y_,z___}->{y,x,y,z}, {0, x:0...,y_,z___}->{y,x,y,z}, {x___,y_,0,z___} -> {x,y,y,z} }; ...


2

I know this is a duplicate but since I failed to find it with ten minutes of searching: x = {2, 0, 0, 7, 0, 3, 0, 0, 1}; FoldList[If[#2 == 0, #, #2] &, x] {2, 2, 2, 7, 7, 3, 3, 3, 1} To handle leading zeros: x = {0, 7, 0, 3, 0, 0, 1}; FoldList[If[#2 == 0, #, #2] &, SelectFirst[x, # != 0 &], Rest @ x] {7, 7, 7, 3, 3, 3, 1} The case ...


4

Here is a recursive solution based on linked lists. It will not be extremely fast, but reasonably efficient for the top-level code, and I think it clearly expresses the recursive nature of parsing. These are some helper functions: These are conversion functions to and from linked list: ClearAll[ll, toLL, fromLL]; SetAttributes[ll, HoldAllComplete]; ...


4

I don't know if it is the Mathematica way (or even if it is the best way), but here is how I would do it. I assume for simplicity that every entry is either an opening or a closing parenthesis (otherwise, some code explicitly ignoring any non-brackets would need to be added). Note that I'm using positionDuplicates by Szabolcs from this answer to another ...


1

I failed to think of anything with competitive performance, however in simply working through the problem I produced a function that is somewhat different from the rest. Despite being slower than the original perhaps it will inspire something better. f1 = Module[{a = Range @ Length @ #}, Scan[(a[[# ;;]] = RotateLeft @ a[[# ;;]]) &, #]; a ] ...


10

My answer is based on a modification of a binary heap. Basically the construction looks something like this. We start with a binary tree: Notice that if we label the nodes breadth-first, the labels have an interesting property. Each parent node $n$ has two children, $2n$ and $2n+1$. This also works in reverse: the parent of node $n$ is node ...


7

I have a tree-based method that has the right asymptotics but a very high coefficient. The upshot being, it will not compete with other methods until we get past 10^6 or so in list size. With considerable work that tree structure could be flattened so that Compile might be brought into play. The basic tree layout is {left subtree, node, right subtree} where ...


2

l = {1, 2, 3, 4, 5}; t = {1, 1, 2, 1, 1}; l2 = t; Fold[(Delete[l2[[#2]] = #1[[t[[#2]]]]; #1, t[[#2]]]) &, l, Range[5]]; l2 (*{1, 2, 4, 3, 5}*)


5

Module[{p = Range[Length@#]}, Reap@Fold[(Sow[#[[#2]]]; Drop[#, {#2}]) &, p, #]] &@{1, 1, 2, 1, 1} (* {{}, {{1, 2, 4, 3, 5}}} *)


12

Preface Below, you will find two different solutions. For understanding the problem itself, the first, iterative solution is better suited since it gives insight in how the solution can be found without directly executing the instructions given as input. Iterative Solution Detailed explanation To explain the idea behind this approach let us work with a ...


2

If I've understood correctly you appear to be wanting a nested delete in which you keep the deleted items in their preserved order of deletion. This solution is probably not any easier than yours but here goes: Rest@FoldList[{Join[#1[[1]], {#1[[2, #2]]}], Delete[#1[[2]], #2]} &, {{}, Range[5]}, {1, 1, 2, 1, 1}] (* {{{1}, {2, 3, 4, 5}}, {{1, 2}, ...


4

You can compute the chromatic index of a graph by first observing it is equivalent to the chromatic number of the line graph of the graph. This immediately suggests straightforward algorithms: ChromaticNumber[g_] := MinValue[{z, z > 0 && ChromaticPolynomial[g, z] > 0}, z, Integers]; ChromaticIndex[g_] := ChromaticNumber[LineGraph[g]]; Notice ...


2

Not acquainted with the SSA algorithm, but I tried to decipher it from your code. Please modify to fix it in your final work. If is not best practice in Mathematica to use For statements, so the following approach is taking advantage of the NestList Command. (*Define the function that will provide the vector state after the next event occured*) ...



Top 50 recent answers are included