Tag Info

Hot answers tagged

11

foo = With[{f = #0}, (# /. {p___, a, b, c, q___} :> Join[{p, "abc"}, f @ {q}])] & lst = {1, 2, a, b, c, 3, {4, a, b, c}, 5}; foo@lst (* {1, 2, "abc", 3, {4, "abc"}, 5} *) This works because With automatically renames the patterns used in RuleDelayed since both are scoping constructs. Other constructs can be used as well such as RuleDelayed itself: ...


7

Probably not fast, but very simple: upperTriangular[elements_, n_] := SparseArray[ Thread[ SymmetrizedIndependentComponents[{n, n}, Antisymmetric[{1, 2}]] -> elements]]


7

Not sure how robust it is, but the following seems to work for PlotRange: ClearAll[plt]; plt = Plot[Sin[x], {x, 0, 3 Pi}, PlotRange -> Automatic, PlotLabel -> Dynamic@("PlotRange is " <> ToString@PlotRange[plt])] and ClearAll[plt1]; plt1 = Plot[Sin[x], {x, 0, 3 Pi}, PlotRange -> Automatic, PlotLabel -> ...


7

You can do this without Table: g[k_] := k^2 + 1 Map[If[# != 6, f[#] = g[#], f[#] = 1] &, Range[10]] {2, 5, 10, 17, 26, 1, 50, 65, 82, 101} You can also use Scan in place of Map (it may be slightly faster for large lists). Note that no result will be displayed, but f will still retain the values stored in it. Scan[If[# != 6, f[#] = g[#], f[#] = ...


6

The docs specify that the domain should (usually) be Reals or Integers. These are keywords. You probably want the "domain" to be specified as a constraint. Maximize[{ Abs[f[{p1, p2, p3, p4, p5}, {0.5, l2}]], {p1 + p2 + p3 + p4 + p5 == 1 && p1 >= 0 && p2 >= 0 && p3 >= 0 && p4 >= 0 && p5 >= 0 ...


5

You can use DisplayFunction for this: Plot[Sin[x], {x, 0, 2 Pi}, DisplayFunction :> (Show[#, Epilog -> Inset["PlotRange is " <> ToString@PlotRange[#], {4, 1}]] &)] Instead of buggy PlotRange and AbsoluteOptions you can use much more reliable plotRange function from this answer: plotRange[plot : (_Graphics | _Graphics3D | ...


5

First step: convert the code without modifications. This is the safest (we don't want to accidentally break the algorithm): {n, d} = Dimensions[var1]; k = ... Do[ var1[[i + 1, d - j]] = var1[[i + 2, j + 2]], {i, 0, k}, {j, 0, k} ] Next step: It looks weird to me that the iteration starts from 0, as both Mathematica and MATLAB index from 1. ...


4

Something like this? This seems to be controlled by WindowElements nb = CreateDocument[ TextCell[StringJoin[Table["abcd ", {50}]], "Text", PageWidth -> 1200], WindowElements -> {}];


4

As others have noted, it's not entirely clear what you want. A possibility is you want to "simplify" the rules so that, on application, all four variables would give numbers. I'll show a way to obtain that and possibly you can modify to suit the actual need. We'll start with the lists of rules and create defining polynomials and also extract the variables ...


4

I realized this is possible to implement rather cleanly using partitionBy as defined here. This method produces the "or even" form shown as the third example. in = Range[6]; PadRight @ partitionBy[in, # &] ~ArrayPad~ {{1, 0}, {0, 1}} $\left( \begin{array}{cccc} 0 & 0 & 0 & 0 \\ 1 & 0 & 0 & 0 \\ 2 & 3 & 0 & 0 ...


4

Here is a semi-imperative function to create an upper-triangular array: upperTriangular[v_] := upperTriangular[v, (1 + Sqrt[1 + 8*Length@v])/2] upperTriangular[v_, n_] := Module[{i = 0}, Array[If[# >= #2, 0, v[[++i]]]&, {n, n}]] The function is expressed using two definitions for a reason that will become clear in a moment. Here it is in action: ...


4

s = 4; lis = Range[s (s - 1)/2]; PadLeft[lis[[1 + # s - (# (1 + #))/2 ;; (1 + #) s - ((# + 1) (2 + #))/ 2]], s, 0] & /@ Range[0, s - 1] // MatrixForm


4

In addition to RunnyKine's recommendation of If here are two other methods to consider. 1: Unset or restore the value Simply Unset f[6] afterward: Do[f[k] = g[k], {k, 10}]; f[6] =. Array[f, 10] {g[1], g[2], g[3], g[4], g[5], f[6], g[7], g[8], g[9], g[10]} Note f[6] is returned as it is undefined. Or if f[6] already has a value save and restore it: ...


3

Update Following the new examples you gave I believe this does what you want: Thread[lists[[All, 1]] -> (lists[[All, 2]] //. lists)] Output: {v[4] -> 2000000000000, v[6] -> 4.92958*10^12, v[15] -> 100000000, v[31] -> 6.*10^11, v[32] -> 0.05, v[33] -> 2000000000000, v[35] -> 400000000000, v[41] -> 1.6*10^12, v[45] -> 1, ...


3

Of course you can use the If also inside the table: Table[If[k != 6, f[k] = g[k], f[k] = 1], {k, 10}] You can also use the If on the right hand side of the assignment: Table[f[k] = If[k != 6, g[k], 1], {k, 10}] If the whole purpose of the table is the assignment, that is you are not really interested in the list it outputs, you can replace Table with ...


3

Here a very direct approach to the problem: list1 = Subsets[{p1, p2, p3}, {2}]; f = Module[{x1 = #[[1, 1]], y1 = #[[1, 2]], x2 = #[[2, 1]], y2 = #[[2, 2]]}, If[x1 > x2 && y1 < y2, #[[1]], #[[2]]] ] &; and then Tally[f /@ list1] However, I'm not sure if the alternative is correct, as it wasn't specified. If you ...


3

This behavior is present in both version 7 and version 10 (Windows). Illustrated: IdentityMatrix[2] // matrixform {{1, 0}, {0, 1}} // matrixform There is a difference between {{1, 0}, {0, 1}} and (the evaluated form of) IdentityMatrix[2]: the latter is a packed array. {{1, 0}, {0, 1}} // Developer`PackedArrayQ IdentityMatrix[2] // ...


2

I can't explain this strange behaviour of GridBox. But replacing it with Grid I get the desired output (also with a.a // matrixform) matrixform[mat_] := TraditionalForm[ DisplayForm[ RowBox[{StyleBox["[", SpanMaxSize -> \[Infinity]], Grid[mat], StyleBox["]", SpanMaxSize -> \[Infinity]]}]]]; To align the numbers properly use Grid[mat, ...


2

simple version With a single codeline, ColorData["Atoms", "Panel"], can be transformed in a click panel for ElementData[]. {ColorData["Atoms", "Panel"] // ReplaceAll[#, RuleDelayed[ "MouseClicked", $_] :> (RuleDelayed["MouseClicked", atomClicked = Part[RuleDelayed["MouseClicked", $], 2, 2, 2, 1, 1, 1]])] &, Dynamic[atomClicked, Initialization :> ...


2

This is an extended version of the brief suggestion that I gave in my comment above. Solve for the tangent points. Solve[{#.# &[{x1, y1} - {0, 0}] == 3^2, #.# &[{x2, y2} - {12, 0}] == 2^2, (y2 - y1)/(x2 - x1) == -((x1 - 0)/(y1 - 0)) == -((x2 - 12)/(y2 - 0))}, {x1, y1, x2, y2}] (* This gives 4 solutions *) Define the extrusion vector. ...


2

A slightly different approach Clear[dominateCount] dominateCount[points : {_, _} ..] := Module[{pairs, dominatePick, pickedPoints}, pairs = Subsets[{points}, {2}]; dominatePick[p1_List, p2_List] := Switch[p1 - p2, {_?NonNegative, _?NonPositive}, p1, {_?NonPositive, _?NonNegative}, p2, _, Null]; pickedPoints = dominatePick @@@ pairs; ...


1

I find the question confusing but piggybacking on Karsten's apparently correct answer you might consider: p = {{4, -1}, {5, -2}, {1, 5}}; list1 = Subsets[p, {2}]; f4[{a_, b_}] := Null[, a, b,][[ Sign[a - b].{1, -1} ]] # - {0, 1} & /@ Tally @ Join[p, f4 /@ list1] {{{4, -1}, 1}, {{5, -2}, 2}, {{1, 5}, 0}} A count of Null represents any case that ...


1

Not sure if I well understand the criterion, because for much more points my results are different from those obtained with f1 and f2 suggested by @Karsten 7. However, they agree with those obtained using dominateCount written by RunnyKine. So, I would have your suggestions about my solution. dominate[l : {{_, _} ..}] := Module[{a, b}, a = Sort[l]; ...


1

It looks to me that the author of the code you are studying has implemented a crude version of the conditional compilation preprocessor macros that are built into C and C++. I'm thinking of #if and #ifdef. I suspect that If[True, (* check classic orthogonality: 2 on [-2,2], not yet on [-1,1] ... *) ntest = 6; xmax = 2; csn = CSfunc[ntest]; ...


1

I classify your question as "Serious" thus, here is my answer. In many cases I have found myself in situations where a "canonical solution" does not seem to exist for a given problem found while creating Mathematica solutions. In those cases I tend to create a reasonable enough solution. When I read your question I remembered that a couple of years ago I ...


1

Here's a procedural, hence compilable solution: Matrixify = Compile[{{lis, _Integer, 1}}, Module[{n, mat, pl = 1, pm = 2, i = 1}, n = Round[(Sqrt[8 Length[lis] + 1] + 1)/2]; mat = Table[0, {n^2}]; Do[ mat[[pm ;; pm + k - 1]] = lis[[pl ;; pl + k - 1]]; i++; pl += k; pm += k + i, {k, n - 1, 1, -1} ]; ...


1

FactorInteger[2434500][[All, 1]] (* {2, 3, 5, 541} *) [[All, 1]] should be read as take all rows, first column


1

I think GridLineData should be optimized by adding a condition as below: Classify the data that has been sorted by using this condition that the numerical difference is small (i.e., two data is very close to) (classification interval is set to δ), In each class of data, the minimum number of as a representative of the group(the last group must take ...


1

Expanding on Mr.Wizard's answer, the side effects can be eliminated simply be doing the work inside a function rather than at top-level. list1 = {a -> b + c, d -> b + c}; list2 = {b -> 1, c -> 1}; f[list1_, list2_] := {list1, list2} /. list2 // Values f[list1, list2] {{2, 2}, {1, 1}} Column@{{a, b, c, d}, list1, list2}


1

Pattern matching approach: Clear[replaceWithZero] replaceWithZero[l_List] := With[{allZero = ConstantArray[0, {3, 3}]}, l //. {a___, x_, b___, y_, c___} /; x != allZero && y != allZero && MemberQ[x + y, 2, {2}] :> {a, x, b, allZero, c}]; replaceWithZero /@ tT // MatrixForm Update: scaling this function up to take ...



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