Tag Info

New answers tagged

1

There seem to be at least two issues here: You are not resetting ExtractionCon = {} inside the outer Do loop, therefore Divided1 grows longer than Partition1 With (1) corrected you will get a different error (repeated): Set::setraw: Cannot assign to raw object 3. >> because the x* Symbols now have values, and they evaluate before the assignment is ...


0

If you're merely interested in finding permutations with a good 'score', and wish to avoid storing huge lists of permutations in memory, consider the simulated annealing algorithm: https://en.wikipedia.org/wiki/Simulated_annealing For this application, the algorithm involves repeatedly swapping two elements of the list to form new candidate solutions. If ...


2

One way to go through all possible permutations is the NextPermutation function from the Combinatorica` package. But one word of advice: Did you really think through what you are trying to do? Let's say you just want to loop through 14! iterations and you will do nothing more than increment a counter and go to the next permutation. Incrementing a counter ...


3

Its not the pure function you trip over, it's the property of Map : it not only maps into elements of a list, but just as well into Plus or Times or into the function with head travis (pardon my pun). Map[z, travis[a, b, c]] gives (* travis[z[a],z[b],z[c]] *)


9

Here is a visualization of the 3 dimensional case. A part of the tensor is indexed by `tensor[[l1, l2, l3]]` where l1, l2, l3 are the indices to levels 1, 2, 3 respectively. Transposing switches how the values are indexed. For example, if new = Transpose[old, {2, 3, 1}], then new[[l3, l1, l2]] == old[[l1, l2, l3]] or new[[l1, l2, l3]] == old[[l2, l3, ...


0

This is more of a math question, but in the spirit of being helpful: I think if you run this code and look at the colors of each matrix you might understand better what transpose does. m = Table[Graphics[{RGBColor[0, .33 i, .33 j], Disk[]}], {i, 1, 3}, {j,1,3}] // MatrixForm; mT = Transpose@Table[Graphics[{RGBColor[0, .33 i, .33 j], ...


4

There are a number of issues here: There is no need to wrap Dynamic around the inner variables of the final input field expression. Indeed, it is harmful as Dynamic is purely a user interface element and acts as a holding wrapper in any other context (like an arithmetic expression). The use of Function in the output expression will cause the variables x ...


-1

Sorry for the confusion. Neither of the proposed answers are correct. Consider the branch cut along the angle $\theta=\pi/4$. $\log(i)$ with this branch cut should return $-3\pi i/2$. @Jens's function returns $i\pi/2$. @Zzz's answer returns the admittedly very wrong $i\pi$. I propose the solution myLog[z_, θ_: 2 Pi] := Log[Abs[z]] + I (Mod[Arg[z], 2 Pi, ...


1

My comment from elsewhere seems relevant here, so I'm reposting it. Here's a Log with a branch cut along any curve of the form $z=-re^{i\theta(r)}$: myLog[z_, θ_: Function[0]] := With[{r = Abs[z]}, Log[z/Exp[I θ[r]]] + I θ[r]] Neat example: ArcTan with a weird branch cut. myArcTan[z_] := Evaluate@ExpToTrig[TrigToExp@ArcTan[z] /. Log[w_] -> myLog[w, # ...


3

Without expanding Binomial into Gamma functions, you can also see that the result is correct based on the following true statement: SeriesCoefficient[(1 + x)^n, {x, 0, k}, Assumptions -> k >= 0] (* ==> Binomial[n, k] *) This is the binomial expansion, valid in particular for n = -1. But that case leads to the alternative expression ...


5

This is obviously an annoying problem - you can't easily keep the flexibility to reload the package with Get during the development and at the same time keep certain functions Protected / Locked. Just Protected by itself can be dealt with, as explained by halirutan in his answer, but if you add Locked, you are out of luck. Perhaps, the easiest way out is to ...


4

Using << (or Get) always attempts to evaluate the package. As you have protected your definitions you get the error messages unless you start a new Mathematica kernel. Better is to use Needs to load your packages (when you are not actively developing the package in question). This checks to see if the package context is already known and only ...


8

When you don't restart the Kernel (by using Quit[] or restarting Mathmeatica) then you will always get this behaviour because (1) you have protected the functions yourself and (2) you try to redefine them by reloading the package. It is like evaluating the following twice: f[x_]:=x^2; Protect[f] During evaluation of SetDelayed::write: Tag f in f[x_] ...


2

According to MathWorld (a great resource with frequent references to Mathematica functions): The falling factorial is implemented in Mathematica as FactorialPower[x, n]. A generalized version of the falling factorial can defined by and is implemented in Mathematica as FactorialPower[x, n, h]. Documentation: FactorialPower


6

Looked up the rules on this. This is how it works. If $n$ and $r$ are negative integers, there is a symmetry relation $\binom{n}{r}=\binom{n}{n-r}$ and now the limit is used. But now $\binom{n}{r}=\binom{-1}{0}$ from above. Hence the above limit is, where $n=-1$ and $r=0$ is n = -1; r = 0; Limit[ Gamma[n + t + 1]/(Gamma[r + 1] Gamma[n + t - r ...


1

Is this is what you are after? Series[Sum[(-1)^n/QPochhammer[q^3, q^3, n], {n, 0, 10}], {q, 0, 10}] // Normal (* 1 + q^6 + q^9 *)


5

How about f[x_, y_] = h - 3.07; Then, drawing candidates dat = {RandomVariate[UniformDistribution[{-2, 2}], np], RandomVariate[UniformDistribution[{-2, 2}], np]} // Transpose; and selecting Show[Select[dat, f @@ # > 0 &] // ListPlot[#, AspectRatio -> 1] &, S] the corresponding data can be exported as Export["test.dat",dat] ...


3

Another version using Subsets. I assume that the initially defined rows are stored in x, so: x = o[[{1, 19, 36, 52, 67, 81, 94, 106, 117, 127, 136, 144, 151, 157, 162, 166, 169, 171}]]; Then the full matrix is constructed with: o2 = Mean[x[[#]]] & /@ SortBy[Subsets[Range[18], {1, 2}], First]; o2 == o (* True *)


3

Another approach, maybe a little easier to understand: Construct an array of only the initially defined rows: initial = o[[#1 (39 - #1)/2 - 18]] & /@ Range[18] ; this table procedure makes use of the fact that your 'initial' rows are also the "average" of the row with itself..: Transpose@ Table[ Flatten@ Table[ (initial[[j, k]] + initial[[i, ...


2

With the new Association data structure introduced in the Wolfram Language/Mathematica 10 (you can try it now on the Raspberry Pi), this becomes extremely very simple to write and lookups are highly efficient as well. property = Association@Thread[elements -> chemistry] property @> Ni (* 0.06 *)


1

Try this: NSolve[x + # == 0, x] & /@ {1, 2, 3, 4} x /. % Flatten[%] {{{x -> -1.}}, {{x -> -2.}}, {{x -> -3.}}, {{x -> -4.}}} {{-1.}, {-2.}, {-3.}, {-4.}} {-1., -2., -3., -4.}


5

I'm assuming here that the OP's code have been evaluated so we can test if the following works. Thanks to george2079 this is the initially populated rows indices list. start = #1 (39 - #1)/2 - 18 & /@ Range[18]; {1, 19, 36, 52, 67, 81, 94, 106, 117, 127, 136, 144, 151, 157, 162, 166, 169, 171} I'm assuming we have rows referring to those ...


1

Using replacement rules in the following fashion: NSolve[x + parameter == 0, x] /. parameter -> {1, 2, 3, 4, 5} gives you: {{x -> {-1, -2, -3, -4, -5}}}


1

Redundant way : Fold[MapAt[2 # &, #1, #2] &, p1, j]


2

p1 = {1, 2, 3, 4, 5, 6, 7, 8}; j = {1, 6, 7, 8}; p1[[j]] *= 2; p1 (* {2, 2, 3, 4, 5, 12, 14, 16} *) Replacing your function (I assume you want to keep the argument/original unchanged and return the changed version): p1 = {1, 2, 3, 4, 5, 6, 7, 8}; domul[p1_] := Module[{replacement = p1, j = {1, 6, 7, 8}}, replacement[[j]] *= 2; replacement]; ...


5

Just do the following: p1[[j]] = 2 p1[[j]] Then p1 gives: {2, 2, 3, 4, 5, 12, 14, 16}


4

I think you need to check your equations and/or the numeric values you are using. To me it looks like this problem might well have no solution: equation = 10000 u'[r] (1 + u'[r]) - 1.`*^-6 (r + u[r]) (u[r] + r u'[r]) + 10000 r u'[r] u''[r] + 10000 r (1 + u'[r]) u''[r] == 0; derivativeAtEndPoint[uStart_?NumericQ] := NDSolveValue[{equation, 10000 ...


3

BSplineFunction[{{0., 1.}, {0., 1.}}, "<>"] is a map from parametric space to "plotting" space, i.e. $\mathrm{BSplineFunction}:(u,v)\mapsto (x,y,z)$, so instead of Plot3D[surfFn[x/7, y/5][[3]], {x, 0, 7}, {y, 0, 5}], it should be written as ParametricPlot3D[surfFn[u, v], {u, 0, 1}, {v, 0, 1}]. cpts = Table[{x, y, RandomReal[{0, 2}]}, {x, 0, 7}, {y, 0, ...


1

In Mathematica: Reduce[ForAll[{x, y}, x <= y \[Equivalent] x < y + 1], Integers] (* True *) or: Resolve[ForAll[{x, y}, x <= y \[Equivalent] x < y + 1], Integers] (* True *) For a mathematical proof, the direct implication $x \leq y \Rightarrow x < y+1$ has the trivial proof noted by @rcollyer in a comment. The converse ...


2

I think you want to define f1 as f1 = Function[u, 3 + u] since the form you started with would have created the function and then applied it to x. The easiest way to do what you want is to use Map: Map[f1, list] which has an equivalent syntax f1 /@ list If you really must use a Do loop, you would do it as follows: Module[{result = {}}, ...


1

Memory inefficient approach: RandomSample[ DeleteCases[Tuples[Range[5], {2}], {n_, n_}], 5] or alternatively with Subsets. RandomSample[Join[{##}, Reverse /@ {##}] & @@ Subsets[Range[5], {2}], 5] Time inefficient approach: list = {}; Do[ While[ While[Equal @@ ({i, j} = RandomInteger[5, 2])]; MemberQ[list, {i, ...


0

EDIT (after Kuba comment) You can use RandomSample ,e.g If the aim is sampling from {1,2,3,4,5}^2: RandomSample[Tuples[Range[5], 2]] yielding {{4, 2}, {4, 3}, {1, 4}, {5, 3}, {1, 1}, {5, 1}, {2, 1}, {2, 4}, {2, 5}, {5, 2}, {1, 2}, {1, 5}, {3, 3}, {4, 5}, {5, 5}, {3, 4}, {2, 2}, {5, 4}, {3, 5}, {1, 3}, {4, 1}, {3, 2}, {2, 3}, {3, 1}, {4, 4}} ...


4

Plot[g[z], {z, 0, 2}, PlotRange -> {{0, 2}, All}]


3

As described in the other answers, Composition or Compose is what you need. Since you also wanted them to be applied in reverse order, the new RightComposition that is in the Wolfram Language is the appropriate function (of course, you can always Reverse the list before feeding to Composition). functionList = {f1, f2, f3}; (RightComposition @@ ...


8

The Wolfram Language and Mathematica 10 (available now on the Raspberry Pi) have new functions — AnyTrue, AllTrue, NoneTrue — which take a predicate and test any/all/none on the input list. For example: AnyTrue[Range@5, EvenQ] (* True *) AllTrue[{True, False, False}, TrueQ] (* or Identity in place of TrueQ *) (* False *) These functions can also be ...


4

I think the most straight forward would be to use Mathematica packages and importing the definitions in that notebook using the function Get as Szabolcs mentioned in the comments. I suggest that you have a closer look at the documentation on how to set up packages in Mathematica. Th principle is quite simple to understand. Here is a small example of how ...


1

In the first notebook: Add[x0_, y0_] := Module[{x = x0, y = y0}, x + y] Save["myFunction", Add] Or put your first notebook in to C:\Documents In the second notebook: Get["myFunction"] Add[1, 2]


2

After some significant time browsing related questions on this site as well as trial and error, I believe that I have managed to create a solution for what I was trying to accomplish. Taking the advice from Ariel I have essentially created my own custom array of checkboxes that do not experience any major delay when one of them is clicked. I have ...


5

Two defintions of f, one each side of a. f[a_?NumericQ, t_?NumericQ] /; a > t := 10 Exp[-0.1 Sin[t]]; f[a_?NumericQ, t_?NumericQ] /; a <= t := f[a, t - 1] Exp[-0.1 a]; Plot it. Plot[f[5, t], {t, 0, 10}]


0

I can't understand your question, what is "sent" etc. but try this for a starting point Manipulate[Plot[Piecewise[{{1 + 3 a, a <= t}, {10 Exp[-0.1 a*20], a > t}}], {a, 0, 2}], {t, 0, 2}]


3

Is this what you are after? Using WhenEvent to find the extrema.. s = Reap[ NDSolve[{y''[t] + (a + b Cos[t]) y[t] == 0, y[0] == 1, y'[0] == 0, WhenEvent[ y'[t] == 0 && y[t] > 0 , Sow[{ t, y[t]}]]}, y, {t, 0, 50}] ] Show[ Plot[Evaluate[y[t] /. s[[1]]], {t, 0, 50 }, PlotRange -> All], ListPlot[s[[2, 1]], ...


3

You can use Outer for this: result = Outer[Plus, Intensity, Intensity]; Image[Rescale[result]]


3

The only thing wrong with your code is that Series doesn't return an expression suitable for evaluation at specific values of the expansion variable. You first have to convert the SeriesData object to a normal expression using Normal. This is the only change needed: i1[ϵ_] = Normal[Series[i[ϵ], {ϵ, 0, 1}]]; With this, the integration works as expected: ...


0

Your question is whether you are doing something fundamentally wrong. My answer is that you are not doing anything wrong but that the behavior you are experiencing is normal for CheckboxBar. I think that there are several potential causes for the slow behavior of CheckboxBar when it is fed with too many items but the final effect is that it is not a ...



Top 50 recent answers are included