Tag Info

Hot answers tagged

10

Could do this with Solve (should take under an hour). vars = Array[x, 12]; Timing[soln = Solve[Flatten[{Total[vars] == 24, Map[0 <= # <= 4 &, vars]}], vars, Integers];] (Breaking report: this eventually finished, in around 23 minutes.) Somewhat faster is to find the degree 24 coefficient of a particular polynomial. The slow step is to ...


8

The reason your last example does not work is that the condition is only interpreted as shared between the body and the signature, when it literally appears within Block, Module, or With at the time the definition is created. In your last example, you effectively postpone the insertion of Condition until run-time, into your newly defined scoping construct, ...


8

Use the OverwriteTarget -> True option. Alas, this is not specified in the documentation. ?? CopyFile gives, among other details, Options[CopyFile]={OverwriteTarget->False} CopyFile[ "foo1.txt", "foo2.txt", OverwriteTarget -> True ] does the trick for me.


7

Use the following IntegerPartitions[24, {12}, {0, 1, 2, 3, 4}] (* Out = {{4, 4, 4, 4, 4, 4, 0, 0, 0, 0, 0, 0}, {4, 4, 4, 4, 4, 3, 1, 0, 0, 0, 0, 0}, {4, 4, 4, 4, 4, 2, 2, 0, 0, 0, 0, 0}, {4, 4, 4, 4, 4, 2, 1, 1, 0, 0, 0, 0}, {4, 4, 4, 4, 4, 1, 1, 1, 1, 0, 0, 0}, {4, 4, 4, 4, 3, 3, 2, 0, 0, 0, 0, 0}, {4, 4, 4, 4, 3, 3, 1, 1, 0, 0, 0, 0}, {4, 4, ...


7

Just a kickstart to get the equations right (yours are wrong) and an idea of the system dynamics: With[{Pr = 10, a = 1.181, b = 0.675, v = 0.77, l = 8/3}, pfun = ParametricNDSolveValue[{ x'[t] == Pr v (y[t] - x[t]), y'[t] == R (b/v) x[t] - a y[t] - (b/v) (R - (a v)/b) x[t] z[t], z'[t] == a l (x[t] y[t] - z[t]), x[0] == y[0] == 0.8, ...


7

You can delay-set the variables of interest to a common variable: Table[x[k] := m, {k, 10}]; m = 4; Table[x[k], {k, 10}] m = 3; Table[x[k], {k, 10}] which produces output {4, 4, 4, 4, 4, 4, 4, 4, 4, 4} {3, 3, 3, 3, 3, 3, 3, 3, 3, 3} This way, whenever m is altered, the rest of the x[k] adapt accordingly. I'm not quite sure how to make it so that ...


6

You can "unify" several variables in the following way x /: HoldPattern[x[k_] = val_] /; 1 <= k <= 10 := (shared = val) x[k_] /; 1 <= k <= 10 && ValueQ[shared] := shared x[2] (* x[2] *) x[3] = 1 (* 1 *) x[9] (* 1 *) x[8] = 0 (* 0 *) x[7] (* 0 *) x[2] = x[3] + 1 (* like shared++ *) (* 1 *) x[11] (* x[11] *) The same for ...


5

What about: repPartition2[list_, n_] := ArrayReshape[list, Table[n, {IntegerExponent[Length[list], n]}]]


5

Alhough your function may be an example and you could use Block or Module to build your list using looping and Append, list manipulation offers great advantages. For the example of splitting a string (including WhiteSpaceCharacter) the following are ways to do it (starting with the built-in function Characters). Characters["this is"] (*mapping StringTake ...


5

I would use Nest: ClearAll[nestedPartition]; nestedPartition[list_, n_] := With[{depth = Log[n, Length[list]]}, Nest[Partition[#, n] &, list, depth - 1] /; IntegerQ[depth] ]; For example nestedPartition[Range[32],2]


5

A real life application... Decision Maker is one of the most useful Mathematica programs I have ever written. It came about because it was a cold and rainy day: I didn't feel like riding my bike home from work, taking the bus would take a long time, and it would be humiliating to ask for a ride. What to do? I couldn't decide, but Decision Maker could: ...


5

The While statement can indeed be used with only a condition. Obviously, While[True] is an infinite loop, While[False] immediately stops, but it may make sense when the evaluation of the condition can be different in each cycle. For example While[n=RandomInteger[{1, 1000}]; Mod[n,100] != 0]; n computes n until it ends on two zeros. In your example eKey ...


5

something like this? ImageApply[ If[ # < .5, {1, 0, 0}, {0, 1, 0}] &, ExampleData[{"TestImage", "Gray21"}] ] another example, looking again I guess you want to leave gray outside the specified ranges. ImageApply[Piecewise[{ {{1, 0, 0}, .1 < # < .3}, {{0, 0, 1}, .6 < # < .7}, {{#, #, #}, True}}] &, ...


4

ip = IntegerPartitions[24, 12]; pck = Pick[ip, Max[#] <= 4 & /@ ip]; base = PadRight[pck]; num = Total[Multinomial @@ Last[Transpose@Tally[#]] & /@ base] ip is candidate partitions pck selects from candidates base: just pads to length 12 with 0 num is the number of permutations: 19611175 You could just sample from base then "sample from ...


4

For a premutation,which contained $n_0$ 0,$n_1$ 1,$n_2$ 2,$n_3$ 3,$n_4$4, So I can achieve two equtions: $$0\times n_0+ 1\times n_1+2\times n_2+3\times n_3+4\times n_4=24 \\ n_0+n_1+n_2+n_3+n_4=12$$ Reduce[n0 + n1 + n2 + n3 + n4 == 12 && n1 + 2 n2 + 3 n3 + 4 n4 == 24 && 0 <= n1 <= n2 <= n3 <= n4 <= 12, {n0, n1, n2, n3, n4}, ...


3

dt=0.04 is too large to plot accurate orbits. Arguments for v1,v2,r1,r2 are adjusted. Clear["Global`"]; dt = 0.0001; Gm1 = 1; Gm2 = 10*Gm1; v1i = {0, 1.2}; v2i = {0, 1.0}; r1i = {1, 0}; r2i = {-1, 0}; f1[r1_, r2_] := -Gm2*(r1 - r2)/((r1 - r2).(r1 - r2))^(3/2); f2[r1_, r2_] := -Gm1*(r2 - r1)/((r1 - r2).(r1 - r2))^(3/2); v1[{v1pre_, r1pre_, r2pre_}] := ...


3

I have accidentally solved the connection problem that I was having by closing my notebook, opening a new one and re-following the instructions on the link that I provided. Here's the code I used from the Wolfram site: Needs["JLink`"]; ReinstallJava[CommandLine -> "java", JVMArguments -> ...


3

Update Another try arrow = Graphics[{Arrowheads[Small], Arrow[{{0, 0}, {6, 0}}]}, ImageSize -> {50,10}]; product[m_, n_] := Module[{s, t}, {{Subscript[r, n]/m[[n, n]]}, t = MapAt[#/m[[n, n]] &, m, n], Table[ s = Subscript[r, i] - t[[i, n]] Subscript[r, n]; t = MapAt[# - t[[i, n]] t[[n]] &, t, i]; s, {i, n + 1, Length[m]}], t} ...


3

Table and MapAt with Span can reduce the code to almost two lines: n = 3; A = RandomInteger[10, {n, n}]; MatrixForm[A] LU = Join[A, IdentityMatrix[n], 2]; res = Table[{LU = MapAt[#/LU[[k, k]] &, LU, k], LU = MapAt[# - #[[k]] LU[[k]] &, LU, k + 1 ;;]}, {k, n}]; Map[augmentedMatrixForm, res, {2}] // Grid With "tags" it is a bit longer LU ...


3

I think the key is Binarize but I couldn't figure out a good way to overlay colored parts on a grayscale image so this is rather hackish. At least it is quite a bit faster than your method: colorize2[image_, α_, β_, γ_, θ_] := ColorCombine[{ ImageSubtract[ImageAdd[img, #1], #2], ImageSubtract[ImageAdd[img, #2], #1], ImageSubtract[img, ##]}] ...


3

IntegerPartitions is the most straightforward way of finding all of the 86 combinations of {0,1,2,3,4} with 12 elements that sum to 24. thils' used IntegerPartitions. So let's find another way. Combinations FrobeniusSolve[{1, 2, 3, 4}, 24] finds all the combinations of {1,2,3,4} having a sum of 24. Some of those will be too long (nSummands > 12). ...


2

We can try like this: Parallelize[MapThread[ImageSubtract, {{image1,image2}, {fond1,fond2}}]] or ParallelTry[imageSubtract, {{imag1, fond1}, {imag2, fond2}}, 2] While imageSubtract[{image_,fond_}]:=Module[{},( Image[(ImageData[image1]-ImageData[fond1]+1)/2] )] We can use also ParallelMap[] ParallelMap[imageSubtract, {{imag1, fond1}, {imag2, ...


2

This question showed up in the "Hot Network Questions" over on StackExchange. I'm not a Mathematica user, so I have no useful answer as to how to solve this with that tool, but I was curious how I'd solve this with programming techniques I know. I've been working on a functional programming library for Javascript, Ramda, and using that I wrote the ...


2

Maybe using Module, something like this: functionA[string_] := Module[{stringWord, n, wordSplit}, n = 1; wordSplit = {}; stringWord = string; While[n - 1 != StringLength[stringWord], wordSplit = Append[wordSplit, StringTake[stringWord, {n, n}]] n++]; wordSplit ] Another option might be to use Block.


2

Probably better (Warning, untested code ... I don't have any Arduino around) xbee = DeviceOpen["Serial", {"COM8", "BaudRate" -> 9600}] RemoveScheduledTask /@ ScheduledTasks[]; lista1 = lista2 = {}; counter = 0; (* getPoll should include code for the interface error management *) getPoll[char_, int_] := (DeviceWriteBuffer[int, char]; ...


1

thanks to belisarius we improved the mathemathica code this way and it works just fine .. hopely we can improve it even more ... saludos desde Mexico xbee = DeviceOpen["Serial", {"COM8", "BaudRate" -> 9600}] RemoveScheduledTask /@ ScheduledTasks[]; lista1 = {}; lista2 = {}; RunScheduledTask[ DeviceWriteBuffer[xbee, "#"]; dato1 = ...


1

You could define a function which creates an array of n constant value var[constant_, n_] := x = ConstantArray[constant, n] For e.g we can make an array of size 5 having 3 as the constant value for all elements as follows var[3, 5] (*{3, 3, 3, 3, 3}*) Since x is equated to this function you can call each array element as follows x[[1]] (*3*) So now ...


1

checking the Head is another way, useful in a construct like this: alist = {{{1, 0}, {0, 1}}, {{0, 0}, {0, 0}}}; Quiet@Select[ {#, LinearSolve[#, {1, 0}] } & /@ alist , Head@#[[2]] == List & {{{{1, 0}, {0, 1}}, {1, 0}}}


1

LinearSolve will generate an error message when it fail. Hence you can catch those messages. Number of ways to do this. Here is an example. mat = {{0, 0}, {0, 0}}; b = {1, 0}; status = True; status = Check[LinearSolve[mat, b], False, LinearSolve::nosol] (* False*) So status can be checked for False. If it is not False, then it passed. So simply set ...



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