New answers tagged

1

when I include the semicolon and the parentheses it seems to work in my Mathematica session like so: MyList = {1, 2, 3, 4, 5, 6, 7} Ex[m_] := Module[ {sample = {}, i = 0}, (While[i < m, sample = Join[sample, RandomSample[MyList, 7]]; i++]; sample) ] Ex[3] {5, 1, 4, 3, 7, 2, 6, 4, 3, 2, 1, 7, 6, 5, 6, 1, 2, 7, 5, 4, 3}


9

dat = {0.71, 0.685, 0.16, 0.82, 0.73, 0.44, 0.89, 0.02, 0.47, 0.65}; Module[{t = 0}, Split[dat, (t += #) <= 1 || (t = 0) &] ] {{0.71, 0.685}, {0.16, 0.82, 0.73}, {0.44, 0.89}, {0.02, 0.47, 0.65}} Credit to Simon Woods for getting me to think about using Or in applications like this. Performance I decided to make an attempt at a higher ...


3

f[x_, y_] := Module[{new}, If[Total[new = Append[x, y]] >= 1, Sow[new]; {}, new]] Reap[Fold[f, {}, dat]][[2, 1]]


3

DateHistogram was added in version 10.2, and uses date-specific bins and ticks. I'll use the same {month, day} data as my other example, but instead of transforming the dates ahead of time, I can use DateFunction to provide the interpretation automatically. blossom = {{4, 3}, {4, 22}, {4, 15}, {4, 2}, {4, 18}, {4, 20}, {4, 12}, {3, 30}, {4, 4}, {4, ...


2

DeleteCases[list, {___, Null, ___}] DeleteCases[list, {___, , ___}] Also with Select and ContainsAny. Select[Not@*ContainsAny[{Null}]]@list


15

list = {{1, 2}, {5, 8}, {4, 1}}; Apply, Function: {#1 + x, #2} & @@@ list (* {{1 + x, 2}, {5 + x, 8}, {4 + x, 1}} *) Map: # + {x, 0} & /@ list (* {{1 + x, 2}, {5 + x, 8}, {4 + x, 1}} *) Part, Transpose: Transpose[{list[[All, 1]] + x, list[[All, 2]]}] (* {{1 + x, 2}, {5 + x, 8}, {4 + x, 1}} *) MapAt: MapAt[x + # &, list, {All, ...


5

The problem is that Dot[a,b] (a and b being atomic, e.g. symbols with no values) evaluates differently than Dot[{a,b},{x,y}] (i.e. the arguments being lists). Dot[{a, b}, x] does not evaluate, so you can transform it using Thread. Dot[{a, b}, {x, y}] does evaluate before it even sees Thread. Dot[{a, b}, {x, y, z}] tries to evaluate and gives up with an ...


5

Reverse takes a level specification so: Reverse[list, 2]


0

Using the Complement function, we can define AreListsEqual very simply as: AreListsEqual[list1_, list2_] := Complement[list1, list2] == Complement[list2, list1]; Duplicates in each list are ignored. Hence, for example, AreListsEqual[{a,a,b}, {a,b}] == True Unfortunately, if the lists are large, it's quite slow. Using @Kellen-Myers' ...


2

Some possibilities: Table[With[{j = j}, f[#, j] &], {j, 3}] Function[{j}, f[#, j] &] /@ Range[3] f[#, j] & /. List /@ Thread[j -> Range[3]]


1

This seems to work. Table[(f[#, i] &) /. i -> j, {j, 1, 3}] (* {f[#1, 1] &, f[#1, 2] &, f[#1, 3] &} *) Note that #1 and # are equivalent.


2

Select[Split[myList, #2 - #1 == 1 &], Length[#] > 1 &]


2

This one is much faster then Plot (but the use depends on your quality needs) Graphics[Line@Transpose[{#, f[#] + g[#]}]] & @ Range[1.2, 10, 0.01]; Show[ ListLinePlot[{Transpose[list], Transpose[list2]}, PlotRange -> {0, 30}], Graphics[Line@Transpose[{#, f[#] + g[#]}]] &@Range[1.2, 10, 0.1] ] Some note on time Plot[f[x] + g[x], {x, ...


2

f[n_] = 351 n^(-0.7); f /@ {2, 9, 22} (* {216.066, 75.3941, 40.3284} *) Or, using a pure function 351 #^(-0.7) & /@ {2, 9, 22} (* {216.066, 75.3941, 40.3284} *) In WolframAlpha use the pure function WolframAlpha["351 #^(-0.7)&/@{2,9,22}"]


10

Proper Input of file and checking the list Make sure that the variable list does contain your file inputs and make sure that Mathematica correctly understands your numbers. For this you might try: list = SemanticImport[ "myfile.txt", "Number", "List" ] or using ReadList you might try: list = ReadList[ "myfile.txt", "Number" ] Then check whether there ...


3

I am only a beginner at Mathematica but I notice that Max is left unevaluated if given non numerical data types: I recommend sampling your data: RandomSample[lista,10} and applying the Head[] function to a few elements which returns the data type


7

This is related to the Orderless attribute of Times and Plus. These attributes could be removed permanently with some hacks, but that would break Mathematica. If you only want to display the result in a certain way, but not do calculations with it, it may be safe to remove those attributes temporarily using Block. Block[{Plus, Times}, With[{result = ...


4

This is not really very efficient but here goes. We can create a rational function that is effectively a generating function in three variables, one to force 8 factors, one to force a sum e1ual to 24, one to force a sum of squares equal to 86. The other parameters just keep track of what factors get used in a coefficient. vals = Range[5]; aa = Array[a, 5]; ...


2

Use the third argument to IntegerDigits to specify the length of the digit sequence required, padded on the left by zero. Thus, reconstructArray = ArrayReshape[IntegerDigits[code, 2, 8*7], {8, 7}]


7

A slightly different approach with Reduce (or Solve) We define: matC = Range[5]; (* the list of the integers from which we build a list *) Let us use a vector to indicate the multiplicities of any integer: matX = Array[ x, 5 ]; (* @Kuba: that's more concise, indeed *) So x[1] will tell us how many times $1$ appears a possible solution. We can then ...


13

Select[ IntegerPartitions[24, {8}, Range[5]], #.# == 86 & ] {{5, 5, 4, 2, 2, 2, 2, 2}, {5, 5, 3, 3, 3, 2, 2, 1}, {5, 4, 4, 4, 2, 2, 2, 1}, {5, 4, 4, 3, 3, 3, 1, 1}, {4, 4, 4, 4, 4, 2, 1, 1}} Slightly more general approach (in case where IntegerPartitions is not what we need): ClearAll[ar, a]; ar = Array[a, 8] ar /. Solve[Flatten@{ ...


4

Make j as the function argument for the matrix. mat[j_] := {{2 j, j, -j, 0}, {2, j, -j, -2}, {2, 3, j, -j}, {0, j, -j, 2}}; Then Manipulate works Manipulate[ mat[j] // MatrixForm, {j, 0, 10, ControlType -> Animator, AnimationRate -> 1, RefreshRate -> 10}]


3

FoldList[Join, List /@ {1, 2, 3, 4, 5}]


2

list={1,2,3,4,5}; Table[Take[list, i], {i, Length[list]}] will give you {{1}, {1, 2}, {1, 2, 3}, {1, 2, 3, 4}, {1, 2, 3, 4, 5}}


3

myList = {1, 2, 3, 4, 5}; Reverse@NestList[Most, myList, Length[myList]-1] Of the four solutions posted, this one is the fastest on large sets. Using Timing and the data set Range[10^3], the execution times are: Table[Take[list, i], {i, Length[list]}] 0.00351 seconds Reverse@NestList[Most, myList, Length[myList]-1] 0.002089 seconds FoldList[Join, List ...


1

x = {1, 2, 3, 4, 5}; x[[;; #]] & /@ Range@Length@x (* {{1}, {1, 2}, {1, 2, 3}, {1, 2, 3, 4}, {1, 2, 3, 4, 5}} *)


4

m = {{2, 5, 1, 0}, {2, 0, -1, -2}, {2, 3, 4, -3}, {0, 1, -2, 2}}; base[m_] := Transpose[SortBy[Eigenvectors[m] // N, Norm]] diag[m_] := Chop[Inverse@#.m.#]&@base[m] diag[m] // MatrixForm


3

For the data in the question, the following also works. ListPlot[Transpose[Split[data, First[#1] === First[#2] &]], PlotStyle -> {Blue, Green, Purple, Orange, Red}] This, of course, assumes that data already is ordered by size. If not, use ListPlot[SortBy[Transpose[Split[data, First[#1] === First[#2] &]], Last], PlotStyle -> ...


3

How about this: n=5; dt = Table[Select[SortBy[data, Last], #[[1]] == j &], {j, 1, n}]; ListPlot[Table[dt[[1 ;; n, eid]], {eid, 1, 5}], PlotStyle -> {Blue, Green, Purple, Orange, Red}]


0

Update Fully compiling the code to C makes it as fast as the built-in: cBernstein = Compile @@ (Hold[{n, {j, _Real, 1}, u}, Table[expr u^i (1 - u)^(n - i), {i, j}], CompilationTarget -> C] /. expr -> FunctionExpand[Binomial[n, i]]) BezierSurface4 = With[{cBernstein = cBernstein}, With[{AllBasis = Function[{deg, u0}, cBernstein[deg, ...


0

How about Graphics3D @ BSplineSurface[cpts] // AbsoluteTiming


3

I think there are two more lines from Position documentation might be relevant for the OP. A positive level n consists of all parts of expr specified by n indices. A negative level -n consists of all parts of expr with depth n. So, for the OP task this code works even with default Heads->True: list = RandomInteger[10, {10, 2}]; Position[list, ...


4

The following is slower than your code, but much more efficient memory-wise. For example for const10 = {3, 1, 2, 3, 1, 1, 1, 2, 3, 1}; it is 25% slower, but while your solution eats up 610MB, this one takes almost nothing. So, it depends on what is more important to you. findN1[currList_, const_] := Module[{n = Length@const, newlists}, newlists = ...


4

You are using the wrong inverse in DecryptChar. You should be using the modular multiplicative inverse but you are using the multiplicative inverse. DecryptChar[char_, a_, b_] := Module[{alphabet, position, shift, mod}, alphabet = Alphabet[]; position = First@Flatten@Position[alphabet, char]; shift = Mod[PowerMod[a, -1, 26] (position - b), 26]; ...


4

Edit (Corrected error in algorithm) You can reverse the encryption with Solve, which can handle modular equations. With[{alphabet = Alphabet[]}, With[{n = Length[alphabet]}, EncryptChar[char_, a_, b_] := Module[{position, shift}, position = Position[alphabet, char][[1, 1]] - 1; shift = Mod[a position + b, n]; ...


3

I don't exactly know why your version doesn't work, but who wants to use loops anyway? Here's a Table version that works: tones = Table[With[{j = j}, Play[Sin[2*Pi*t*500/Exp[-0.1*j/20]], {t, 0, 1}]], {j, 0, 40}] For some reason, putting the With in there makes it work, whereas without the With, it doesn't. This also makes your code work: tones = {}; ...


3

Another possibility is sol = Solve[s^2 + a*s + b == 0, s]//Flatten; Sum[C[i] Exp[sol[[i, 2]] t], {i, Length[sol]}] But, why not just DSolve[y''[t] + a y'[t] + b y[t] == 0, y[t], t][[1, 1, 2]] both of which give (* E^(1/2 (-a - Sqrt[a^2 - 4 b]) t) C[1] + E^(1/2 (-a + Sqrt[a^2 - 4 b]) t) C[2] *) Addendum A bit more compact is ...


3

There are many possibilities. You could do something like sols = Flatten@Module[{i=1}, Solve[s^2 + a*s + b == 0, s] /. s :> s[i++]]; (* {s[1] -> 1/2 (-a - Sqrt[a^2 - 4 b]), s[2] -> 1/2 (-a + Sqrt[a^2 - 4 b])} *) Alternatively, sols = Solve[s^2 + a*s + b == 0, s]; exprs = {c1 Exp[s t], c2 Exp[s t]}; Plus @@ MapThread[#1 /. #2 &, {exprs, ...


12

The documentation for Position provides the answer: The default level specification for Position is {0,Infinity}, with Heads->True. You're not setting Heads -> False, so Position will look at: Level[{{8, 7}, {10, 8}, {6, 10}, {3, 2}, {9, 8}, {0, 1}, {2, 1}, {1, 10}, {6, 8}, {5, 9}}, 1, Heads -> True] Which is: {List, {8, 7}, {10, 8}, {6, ...


2

Adapted from my answer to a related question: runs[a_List] := Range[Prepend[# + 1, 1], Append[#, Length@a]] &@ SparseArray[Differences@a]["AdjacencyLists"] Now: runs @ {2, 2, 7, 0, 7, 7, 2, 2, 2} {{1, 2}, {3}, {4}, {5, 6}, {7, 8, 9}}


2

m1 = {2, 2, 7, 0, 7, 7, 2, 2, 2}; Module[{i = 1}, Replace[Split@m1, _ :> i++, {-1}]] (* {{1, 2}, {3}, {4}, {5, 6}, {7, 8, 9}} *)


1

SplitBy[Transpose[{m1, Range@Length@m1}], First][[;; , ;; , -1]] or m2 = Range@Length@m1; i = 1; Split[m2, m1[[j = i++]] === m1[[j + 1]] &]


7

This one prevents the distribution problems halirutan is talking about: h[n_] := Module[{m}, m = RandomReal[{0, 10}, {n, n}]; m SparseArray[{i_, j_} /; i >= j -> 1, {n, n}] + Transpose[m SparseArray[{i_, j_} /; i > j -> 1, {n, n}]] // Normal ] h[5] // TableForm Distribution is uniform now: Histogram@Flatten@h[1000]


9

First, you just have to create exactly one H[N] and use this 2 times. This can be achieved by H[n_] := RandomReal[{0, 10}, {n, n}] symmetryH[n_] := With[{hn = H[n]}, (hn + Transpose[hn])/2 ] Second, please do not use N as variable or pattern. It might shoot you in the foot because it is a function in Mathematica. Finally, you should realize, that your ...


0

One can use the Module to declare a local variable: H[N_] := RandomReal[{0,10},{N,N}] symH[N_]:=Module[{h=H[N]},(h+h\[Transpose])/2]; symH[4]//MatrixForm This should work.


3

This does not answer your question but rather offers a visual, albeit less accurate, alternative to a function. {atomicNumber, atomicMass} = Panel[ WolframAlpha[ "periodic table of the elements", {{"PeriodicTableProperties:ElementData", 1}, "Content"}, PodStates -> { "PeriodicTableProperties:ElementData__Atomic ...


6

There is a complicated trade-off between the speed and compact form in this case, so I have decided to post the version with Range, which I consider simple enough (comprehensible for new users) and second fast among the conterparts (at least, on my machine). It is heavily based on @Mr.Wizard solution farsightedly provided by ChrisDegnen, so I do not claim ...


6

The way to go about solving this problem is: In the Documentation Center, type "atomic mass" into the search field. The 2nd hit on the search results will ElementData. Click on it. The 1st example under Basic Examples is ElementData["Carbon", "AtomicWeight"] Quantity[12.0107, "AtomicMassUnit"] this gives the hint one needs to get started. It turns ...


1

I'll add another option, but be warned: It's rather slow. FoldPairList[TakeDrop, Range@Length@m1, Length /@ (Split @ m1)]


3

Too late for the party so here's something old style: Module[{i = 0}, Map[++i &, Split[m1], {-1}]] or SplitBy[MapIndexed[Flatten@*List, m1], First][[;; , ;; , 2]]



Top 50 recent answers are included