Tag Info

New answers tagged

0

Excellent discussion and great explanations. The following will retrieves all expressions of list at all levels sorting by Position (rfli ). Might help when looking to extract specific elements from an expression. Useful with ragged lists. So if x= F[G[a, K[d]], H[b, L[e]], J[c, M[P[f, g]]]] rfli[x] will be: rfli[list_] := (coltitles = {"Expression", ...


2

args = {{m1, n1}, {m2, n2}, {m3, n3}, {m4, n4}}; f @@@ args {f[m1, n1], f[m2, n2], f[m3, n3], f[m4, n4]} Apply[f, args, {1}] {f[m1, n1], f[m2, n2], f[m3, n3], f[m4, n4]} f @@ # & /@ args {f[m1, n1], f[m2, n2], f[m3, n3], f[m4, n4]} f[Sequence @@ #] & /@ args {f[m1, n1], f[m2, n2], f[m3, n3], f[m4, n4]} % == %% == %%% == ...


1

Simplify[(Cos[2*a + b + c]*Tan[a + 2*b + 2*c])/ Sin[(b + c - a)/2]] /. (b -> Pi - a - c) // TrigExpand Tan[a] Simplify[(Sin[(6*Pi)/5 + x])^2 + (Sin[(4*Pi)/5 - x])^2 // Simplify, Pi/5 + x == ArcCos[m^-1]] // Together (2*(-1 + m^2))/m^2


3

How about getting Mathematica to do the work for us? FullForm[Sequence @@ (XMLNote[#1, m] &) /@ attributes ] // HoldForm Which yields: Apply[Sequence,Map[Function[XMLNote[Slot[1],m]],attributes]] These two expressions are formally equivalent in every single way (they are a different syntax for the same thing). If they yield different results, there ...


1

In Mathematica Abs is a Listable function which means that it may be applied to a scalar, matrix, or tensor directly: m1 = {{1, -8, 3}, {-1, -7, 9}, {-1, 0, -9}}; Abs[m1] {{1, 8, 3}, {1, 7, 9}, {1, 0, 9}} UpperTriangularize works like this: UpperTriangularize[{{1, 2, 3}, {4, 5, 6}, {7, 8, 9}}] {{1, 2, 3}, {0, 5, 6}, {0, 0, 9}} Matrix product ...


2

Update You could just make the equal indices vanish: Sum[Sign[Abs[i - j]] c[i] \[Phi][i, j] \[Beta][j], {i, 1, 4}, {j, 1, 4}] or better as @Guesswhoitis. using Iverson notation concept: Sum[Boole[i!=j] c[i] \[Phi][i, j] \[Beta][j], {i, 1, 4}, {j, 1, 4}] or somewhat ridiculous: mat[sym_, m_, n_] := Normal@SparseArray[{i_, j_} :> sym[i, j] ...


1

pairs = ## & @@@ {#, Reverse /@ #} &@Subsets[Range[4], {2}]; {{1, 2}, {1, 3}, {1, 4}, {2, 3}, {2, 4}, {3, 4}, {2, 1}, {3, 1}, {4, 1}, {3, 2}, {4, 2}, {4, 3}} Total[β[#2] ϕ[##] C[#] & @@@ pairs] (*or Sum[β[k[[2]]] ϕ[##&@@k] C[k[[1]]],{k,pairs}] *) C[1] β[2] ϕ[1, 2] + C[1] β[3] ϕ[1, 3] + C[1] β[4] ϕ[1, 4] + C[2] β[1] ...


1

r1=Plus @@ (\[Beta][#2]*\[Phi][#1, #2]*C[#1] & @@@ A); or r2=expr1[i_, j_] = Sum[If[i == j, 0, \[Beta][j]*\[Phi][i, j]*C[i]], {i, 1, 4}, {j, 1, 4}] r1 === r2 (*True*)


0

Good question. A quick search for "unsorted" in the Mathematica search box yields entries for DeleteDuplicates and Reap. Timing these two: list = RandomInteger[5, 1000000]; Timing[Reap[Sow[1, list], _, # &][[2]]] Timing[DeleteDuplicates[list]] (* {0.592804, {5, 1, 4, 3, 0, 2}} {0., {5, 1, 4, 3, 0, 2}} *) There are many other ...


2

♭♭ = ## & @@@ {#2 & @@@ #2, #} & @@ # &; Example: lst ={{35.3919, {x -> 3.17532, y -> 0.826616}}, {22.7658, {x -> 2.74215, y -> 1.86474}}, {47.6532, {x -> 2.59448, y -> 5.939}}, {51.3295, {x -> 2.25842, y -> 5.10077}}, {26.2436, {x -> 1.23835, y -> 2.10218}}, {36.0848, {x ...


3

ListPointPlot3D[Join[#[[2,All,2]],{#[[1]]}]&/@yourList] ... or use ListPlot3D rather than the point plot. The command inside the ListPointPlot3D will extend to more dimensions and also works when your list contains say... {{43, {u->6,v->2,w->5}} <<more items>> }


2

s = {value, {x -> value_x, y -> value_y}} {x /. s[[2]], y /. s[[2]], s[[1]]}


5

eqs = Table[{y == (1/Sqrt[3])*x + i, y == -(1/Sqrt[3])*x + i, x == i*Sqrt[3]/2}, {i, -7, 7}]; ParametricPlot[ Evaluate[{x, y} /. ToRules /@ Flatten[eqs] /. {x -> t, y -> t}], {t, -3, 3}, PlotRange -> 3]


5

eqns = Table[{y==(1/Sqrt[3])*x+i,y == -(1/Sqrt[3])*x+i}, {i, -3, 3}]; ContourPlot[Evaluate[## & @@@ eqns], {x, -3, 3}, {y, -3, 3}] eqns2 = Table[{ x == i Sqrt[3]/2, y == (1/Sqrt[3])*x + i, y == -(1/Sqrt[3])*x + i}, {i, -7, 7}]; ContourPlot[Evaluate[## & @@@ eqns2], {x, -3, 3}, {y, -3, 3}]


7

You need to either join all desired plots, e.g. ContourPlot[#, {x, -10, 10}, {y, -10, 10}, ContourStyle -> Red] &@(Join @@ Table[{y == (1/Sqrt[3])*x + i, y == -(1/Sqrt[3])*x + i, x == i*Sqrt[3]/2}, {i, -7, 7}]) or Show, e.g.: Show[ContourPlot[#, {x, -10, 10}, {y, -10, 10}, ContourStyle -> Red] & /@ Table[{y == ...


3

If you have version 10 or later you can use operators forms, i.e. Map[Tr] acts as a function: mylistofmatrices = {{{a, b}, {c, d}}, {{q, r, s}, {t, u, v}}}; Map[Tr][mylistofmatrices] {a + d, q + u} This is a subtle difference but it may be useful nevertheless. If you always want the trace of a tensor with a specific array depth you can check for ...


7

No, there isn't. There are several reasons for that: Tr operates on tensors of arbitrary rank, not just matrices Listable functions will automatically thread to the deepest level of lists, so if you set Tr to be Listable, it'll individually wrap each deepest element of a nested list, e.g. Tr[{{1,2},{3,4}}] would transform to {{Tr[1], Tr[2]}, {Tr[3], ...


0

You can construct your list within the argument of manipulate using NestList (see its documentation). This function applies a function you give it (e.g. your $g$ function) to an argument repeatedly. For instance, the following expression starts from the value $2$, applies the pure function 3# & to it (= "take the argument, multiply it by 3"), and ...


2

You have trailing commas on each line that are imported as empty strings. imported = Import["csv.txt", "CSV", HeaderLines -> 2] {{700.0443115, 0.08416349441, ""}, {699.0369263, 0.08557280153, ""}, {698.0291138, 0.08568932861, ""}, {697.0210571, 0.08601997793, ""}, {696.0126343, 0.08787558973, ""}, {695.0039063, 0.08656696975, ""}, {693.994812, ...


6

This is fugly but fulfils the need of staying in the Dataset domain and is much quicker for large datasets. Basically if we use the analogy of a dataset being a SQL table - I do what I would do in the same situation. Create a dummy key on each, join, then drop the dummy key. Personally for small Datasets I prefer the @Mr.Wizard approach from a readability ...


0

I post this for illustration/motivation. A crossover function based on that suggested by OP code. Note have made no effrot to deal with unequal list lengths and order of arguments. xo[s1_, s2_] := With[{n = RandomInteger[{1, Length[s1] - 2}]}, n -> {s1[[1 ;; n]]~Join~s2[[n + 1 ;; -1]], s2[[1 ;; n]]~Join~s1[[n + 1 ;; -1]]}] Visualizing cross ...


4

Here's a way to define a function that does your computation: With[{WN = WhiteNoiseProcess[NormalDistribution[0, 10]]}, aV[m_] := Module[{data, points, yBinLst, meanLst}, data = RandomFunction[WN, {1, 10000}]; points = data["Values"]; yBinLst = Partition[points, m]; meanLst = Mean /@ yBinLst;; Total[Differences[meanLst]^2]/(2 ...


3

Perhaps this will help you. crossover[c1_List, c2_List] /; Length @ c1 == Length @ c2 := Module[{cut, c1a, c1p, c2a, c2p}, cut = RandomInteger[{2, Length @ c1 - 1}]; {c1a, c1p} = {c1[[1 ;; cut]], c1[[cut + 1 ;; -1]]}; {c2a, c2p} = {c2[[1 ;; cut]], c2[[cut + 1 ;; -1]]}; {cut, Join[c1a, c2p], Join[c2a, c1p]}]; SeedRandom[42]; genome1 ...


0

Update: I'll leave my answer here just in case, but I think m_goldberg's interpretation of the OP's request in his answer makes more sense than mine. Let's generate two random matrices: SeedRandom[1] matrixA = RandomInteger[10, {6, 4}] matrixB = RandomInteger[10, {6, 4}] You seem to want to calculate the crossover by applying some function f to ...


7

This looks nicer in a Notebook: Join[d1\[Transpose], d2\[Transpose]]\[Transpose] Unfortunately transposing a Dataset is very slow. Gordon Coale's alternative is much faster, but the original Dataset@Join[Normal@d1, Normal@d2, 2] is more than an order of magnitude faster than that.


2

Version 10.1 includes ReIm which performs the operation you chose as your example. You'll need to add ComplexExpand to get the output you show: ReIm[Exp[I x]] // ComplexExpand {Cos[x], Sin[x]} More generically you can make use of Map or Through. A complication arises if you are dealing with expressions which you do not want to evaluate prematurely. ...


2

thru1 = Assuming[Element[x, Reals], Simplify @ Through @ {Re, Im} @ ComplexExpand@#]&; thru1 @ Exp[ I x] (* {Cos[x], Sin[x]} *) Or thru2 = Composition[Assuming[Element[x, Reals], Simplify@#] &, Through@{Re, Im}@# &, ComplexExpand]; thru2 @ Exp[I x] (* {Cos[x], Sin[x]} *) Or thru3 = Fold[#2[#] &, Exp[I x], ...


1

ApplyList[f_List, exp_] := Map[#1[exp] &, f] However, without specifying if x is real, Mathematica will not output {Cos[x],Sin[x]}: ApplyList[{Re, Im}, Exp[I x]] Out= {Re[E^(I x)], Im[E^(I x)]} ApplyList[{Re, Im}, Exp[I x]] // ExpToTrig // Simplify[#, Assumptions -> Element[x, Reals]] & Out= {Cos[x], Sin[x]}


2

I offer the following function with the caveat that I have not tested it on a computer with Mathematica. That being said, SplitBy[] expects a function that is applied to the elements of a list that, within a group, should give the same result. On a hunch, I went with Coefficient[PowerExpand[Log2[#]], n] &; Log2[] is supposed to isolate only the ...


6

It is possible to Compile Position itself for machine types (e.g. Integer or Real): posmax = Compile[{{list, _Integer, 1}}, Position[list, Max@list] ]; Performance: x = RandomInteger[{1, 100}, 10^7]; Position[x, Max@x] // Timing // First posmax[x] // Timing // First 0.44754 0.0736 With a C compiler this should be faster still; I'll find out in a ...


5

My proposal: Nearest[list -> Automatic, Max[list], {All, 0.5}] Among non-C solutions, it's slightly faster than Pickett's, but slower than Simon Woods's. list = RandomInteger[{1, 100}, 10^7]; Needs["GeneralUtilities`"]; Nearest[list -> Automatic, Max[list], {All, 0.5}] // AccurateTiming SparseArray[Unitize[list - Max[list]] - ...


13

For a 1D list you can also use Pick[Range@Length@list, list, Max@list]


14

A fast uncompiled alternative without pattern matching is to use the NonzeroPositions property of SparseArray, as long as you're dealing with numerical data. list = RandomInteger[{1, 100}, 10^7]; Needs["GeneralUtilities`"] SparseArray[Unitize[list - Max[list]] - 1]["NonzeroPositions"] // AccurateTiming (* 0.120459 *) Position[list, Max[list]] // ...


2

I think this works Ordering[dat, -Count[dat, Max[dat]]] but it is actually slower than Position[dat,Max[dat]] This also works, but again, it's still slower pos1[list_, max_] := Block[{i = 1, l = Length[list]}, Last[Reap[While[i <= l, If[list[[i]] == max, CompoundExpression[Sow[i], i++], i++]]]]] ... unfortunately so is this more compact solution ...


9

For a one-dimensional list: compPos = Compile[{{list, _Integer, 1}, {max, _Integer}}, Block[{copy = list, i = 1}, Do[ If[ list[[j]] == max, copy[[i++]] = j], {j, Length[list]}]; copy[[1 ;; i - 1]] ], CompilationTarget -> "C" ]; Though I think Position is a good non-compiled alternative in this case, since the "pattern" ...


6

♯0 = # #[[;; , 1]] / #2 &; ♯0[lst1, lst2] Alternatively, Divide[lst1, lst2 ] lst1[[;;, 1]] lst1/lst2 lst1[[All, 1]] (* same output *)


5

Using MapIndexed lst1 = {{x1, y1}, {x2, y2}, {x3, y3}, {x4, y4}}; lst2 = {{x1, z1}, {x2, z2}, {x3, z3}, {x4, z4}}; MapIndexed[{First@#1,(First@#1/Last@#1)*lst2[[Last@#2,2]]}&,lst1]


7

Join is quite clean I think: lst1 = {{x1, y1}, {x2, y2}, {x3, y3}, {x4, y4}}; lst2 = {{x1, z1}, {x2, z2}, {x3, z3}, {x4, z4}}; {#, #*#4/#2} & @@@ Join[lst1, lst2, 2] {{x1, (x1 z1)/y1}, {x2, (x2 z2)/y2}, {x3, (x3 z3)/y3}, {x4, (x4 z4)/y4}} For more efficiency a Transpose pair lets one operate by column enabling vector arithmetic on packed arrays: ...


2

You can use PartitionMap from Developer package, e.g. lst = {{59.1915, 42.0843}, {62.0695, 71.2996}, {48.4124, 52.1423}, {51.3325, 60.8624}, {54.8544, 44.72}, {55.39, 63.9032}, {59.1566, 67.2319}, {48.1271, 57.0733}, {63.0908, 76.0996}, {50.644, 47.5917}}; Developer`PartitionMap[Dot @@ # &, Differences@lst, 2, 1] yields: {-598.991, ...


9

lst1 = {{x1, y1}, {x2, y2}, {x3, y3}, {x4, y4}}; lst2 = {{x1, z1}, {x2, z2}, {x3, z3}, {x4, z4}}; {#1, #1 #4/#2} & @@@ (Flatten[#, 1] & /@ Thread@{lst1, lst2}) $\left\{\left\{\text{x1},\frac{\text{x1} \text{z1}}{\text{y1}}\right\},\left\{\text{x2},\frac{\text{x2} \text{z2}}{\text{y2}}\right\},\left\{\text{x3},\frac{\text{x3} ...


3

Here's how I'd do it. Starting with diffcoord diffcoord = {{2.87796, 29.2153}, {-13.6571, -19.1573}, {2.9201, 8.7201}, {3.52192, -16.1424}, {0.53561, 19.1832}, {3.76663, 3.32865}, {-11.0295, -10.1585}, {14.9637, 19.0262}, {-12.4468, -28.5079}}; Pair each element with the next and Dot the pairs. ...


2

Leonid Shifrin's implementation of a trie can be used for this purpose. It is available both for lists and for associations. For associations: ClearAll[makeTreeAssoc]; makeTreeAssoc[wrds : {__String}] := Association@makeTreeAssoc[FileNameSplit /@ wrds]; makeTreeAssoc[wrds_ /; MemberQ[wrds, {}]] := makeTreeAssoc[DeleteCases[wrds, {}]]; makeTreeAssoc[wrds_] ...


0

Your wording is very ambiguous. You start with coordinates, then calculate the differences between successive points, and then claim you want to calculate dx1*dx2 + dxy*dy2 for each pair of coordinate [sic] in the list. Do you mean for each successive pair of two-element lists? Or the outer product, i.e., the differences between the each two-element list ...


3

First off, a more compact form of filesInDir: fileTree[f_, d_] /; DirectoryQ[f] && d > 0 := FileNameTake[f] -> (fileTree[#, d - 1] & /@ FileNames[___, f]) fileTree[f_, _] := FileNameTake[f] Example usage: fileTree[$UserBaseDirectory, 2] (* "Mathematica" -> {"ApplicationData" -> {"CCompilerDriver", "DeviceFramework", ...


1

Update: much simpler now. If this works right I think I would consider it superior. Update 2: I attempted to add specific handling of files and directories. Please tell me if this appears to work and produce a format that is acceptable to you. fn[x : {___, {_, __}, ___}] := Normal @ GroupBy[x, First -> Rest, fn] fn[x_List] := Join @@ x files = ...


1

Here is my second stab at the problem. The first time I tried this, I was using Interpolation to find the expression of the parabolas, but the Manipulate wrapper was quite sluggish. @GuessWhoItIs. pointed out that InterpolatingPolynomials might be a snappier choice in this case. As I understand it, this function constructs a Newton divided difference ...


2

Edit: revised to perform the correct operation this time! In many cases this code appears to be faster than either your own SparseArray formulation or kguler's Internal`DeleteTrailingZeros methods: unPad = MinMax /@ SparseArray[#]["AdjacencyLists"] /. pos_ :> Take @@@ Pick[{#, pos}\[Transpose], UnitStep @ pos[[All, 1]], 1] &; A few ...


0

Version 10.1 introduces SequencePosition, SequenceCases, and SequenceCount. SequenceCount[list, sub] gives a count of the number of times sub appears as a sublist of list. SequenceCount[list, patt] gives the number of sublists in list that match the general sequence pattern patt. All three functions take the Overlaps option: With ...


7

f[list_] := Join @@ (Tuples[ Transpose[{#, 1/#}] ] & /@ Subsets[list, {1, ∞}]) f[{2,3,4}] {{2}, {1/2}, {3}, {1/3}, {4}, {1/4}, {2, 3}, {2, 1/3}, {1/2, 3}, {1/2, 1/3}, {2, 4}, {2, 1/4}, {1/2, 4}, {1/2, 1/4}, {3, 4}, {3, 1/4}, {1/ 3, 4}, {1/3, 1/4}, {2, 3, 4}, {2, 3, 1/4}, {2, 1/3, 4}, {2, 1/3, 1/ 4}, {1/2, 3, 4}, {1/2, 3, 1/4}, {1/2, ...


5

A couple of ideas come to mind. Here's one approach - get all subsets of a list of equal length in symbolic form, then iterate each symbol over the member of the list and its inverse. list = {2, 3}; Flatten[ Table[ Evaluate@Subsets[Array[f, Length[list]], {1, Infinity}], Evaluate@ (Sequence @@ Array[{f[#], {list[[#]]^-1, list[[#]]}} &, ...



Top 50 recent answers are included