Tag Info

New answers tagged

2

Oh well, the solution to my problem is trivial. I simply have to change the definition of my theta function, like this : Angles := {0.0902266, 0.0889051, 0.0869336, 0.0840726, 0.0838656, ...} theta[n_] := Angles[[n]] Then I can use the length command on the Angles : Nangles = Length[Angles];


3

You can take advantage of how the rules associated with theta are stored behind the scenes by doing Length @ DownValues[theta][[1, 2, 1]] (* 40 *) This isn't robust, however. In the sense that if you have defined beforehand theta[10] = 5, for instance, then it won't find the right DownValue. Alternatively, you can build the checking into the function: ...


3

(myMatrix[[#, #]] = 1) & /@ myIndices;


5

f = MapAt[1&, #, Thread[{#2, #2}]] &; f[myMatrix, myIndices] (* {{1, 0, 0}, {0, 0, 0}, {0, 0, 1}, {0, 0, 0}, {0, 0, 0}, {0, 0, 0}} *)


3

myMatrixFinal = ReplacePart[myMatrix, {#, #} & /@ myIndices -> 1]


8

Try this: Set[myMatrix[[#, #]], 1] & /@ myIndices; Or: ReplacePart[myMatrix, {{#, #} & /@ myIndices -> 1}] Or: SparseArray[({#, #} -> 1 & /@ myIndices), Dimensions@myMatrix] // Normal


4

This is indeed somewhat confusing when you are new to Mathematica. In Mathematica, == stands for mathematical equality. Thus a == 0 does not evaluate to either True or to False until a is replaced by a numerical value. a is considered to be a variable that may or may not be zero. A pattern like x_ /; condition will only match if condition is explicitly ...


5

Taliesin Beynon stated in reply to Held keys in associations: Keys have to remain unevaluated for associations to have any efficiency advantages over ordinary lists of rules. There's no way around that. Apparently this is simply another manifestation of Replace inside Held expression and the same solution applies: Replace[ass, a : {_, _, _} :> ...


9

The Notation package is not necessary to use an infix form of \[Star] as that is handled automatically. Also I recommend PadRight for constructing your expression (reference Generating a matrix using sublists A and B n times). SetAttributes[Star, HoldFirst] Star[a_List, n_Integer] := PadRight[a, n*Length@a, a] {1, 2}⋆5 (* ⋆ is \[Star] *) {1, 2, ...


6

Brief? How about this. Define: c = ConstantArray; Now you can get what you want using the infix notation: "a"~c~7 and 10~c~7 With lists {1, 2}~c~7 you'll need to Flatten.


2

Using @Guess comment answer, but spelled out in more detail: a = {{1, -3, 2, -2}, {3, -2, 0, -1}, {2, 36, -28, 27}, {1, -3, 22, 5}}; L = {{1, 0, 0, 0}, {b, 1, 0, 0}, {c, d, 1, 0}, {e, f, g, 1}}; U = {{1, -3, 2, -2}, {0, h, i, j}, {0, 0, k, l}, {0, 0, 0, m}}; result = {L, U} /. First @ Solve[L.U == a]; MatrixForm /@ result Note that matrix multiplication ...


7

Unevaluated@Sequence[1, 2]~ConstantArray~10 $\ $ {1, 2, 1, 2, 1, 2, 1, 2, 1, 2, 1, 2, 1, 2, 1, 2, 1, 2, 1, 2} Or using Notation << Notation` Notation[ParsedBoxWrapper[ RowBox[{ RowBox[{"[", "const_", "]"}], "\[Star]", "reps_"}]] \[DoubleLongRightArrow] ParsedBoxWrapper[ RowBox[{ RowBox[{"Unevaluated", "@", RowBox[{"Sequence", "[", "const_", ...


1

There is a LUDecomposition function in Mathematica: a = {{1, -3, 2, -2}, {3, -2, 0, -1}, {2, 36, -28, 27}, {1, -3, 22, 5}}; n = Dimensions[a][[1]]; {LU, MP, MC} = LUDecomposition[a] LU = First[LUDecomposition[a]] L = LU * SparseArray[{i_, j_}/; j<i -> 1, {n, n}] + IdentityMatrix[n] U = LU * SparseArray[{i_, j_}/; j>=i -> 1, {n, n}] L.U


4

I'm not thrilled with the question since it provided no example, but there was a serious response and also a request to see an ILP approach. Here is one such. Start by creating an example. SeedRandom[1111]; n = 10; m = 4; intset = RandomInteger[100, n] (* Out[335]= {9, 78, 23, 59, 95, 51, 24, 29, 99, 68} *) Now we set up the ILP. We have our n -1/0/1 ...


2

The following function will find the number of loops for a particular variable: countLoopsWithVar[all_, var_] := Count[all, _?(MemberQ[Flatten[List @@@ #, 1], var] &)] For example, countLoopsWithVar[cycles, 1] returns 0; replacing 1 with 2 returns 3. The way it works is to convert from rules to lists and then checks whether the list is ...


5

Through[{KeyDrop, KeyTake}[asc, {"c", "f"}]]


3

Just a Reap/Sow variant. test = {{1, 1}, {1, 2}, {1, 2, 3}, {2, 3}}; Last@Reap[Sow[{##}, #] & @@@ test, _, {Length@#2, #2} &]


8

As has been discussed in the comments you can also use GatherBy. d = {{1, 1}, {1, 2}, {1, 2, 3}, {2, 3}}; {Length[#], Sequence @@ #} & /@ GatherBy[d, First] (*{{3, {1, 1}, {1, 2}, {1, 2, 3}}, {1, {2, 3}}}*)


5

Map[{Length@#, #} &, Union /@ Gather[#, First[#1] === First[#2] &]] &@{{1, 1}, {1, 2}, {1, 2, 3}, {2, 3}} (* {{3, {{1, 1}, {1, 2}, {1, 2, 3}}}, {1, {{2, 3}}}} *) Do note, you've reversed the order of tally output in your example (which the above follows): tally puts element first, then count. If you want all elements including duplications, ...


4

Generally speaking, one tends to get the most out of Mathematica by trying to avoid explicit loops (e.g. For, Do, etc) in favor of functional expressions (e.g. Map, Fold, Nest, ...). If I understand what you are looking for, all you need is the following: (* YOUR CODE *) Clear[x]; a = 0.1; b = 0.01; k = (10*Cos[t] + 20); years = 3; s = NDSolve[{x'[t] == ...


4

Solution Suppose the list is list = Range[-3, 3] (* {-3, -2, -1, 0, 1, 2, -3} *) Then, the set of all subsets of, say, size 3 is sets = Subsets[list, {3}]; We define a list of signs that give all possible combinations of plusses and minuses to attach to each subset: signs = Tuples[{-1, 1}, 3] (* {{-1, -1, -1}, {-1, -1, 1}, {-1, 1, -1}, {-1, 1, 1} ...


1

Try the following: (* Import your data as tab-separated values; extra "" will be included *) Import["c:\\Users\\Marco\\Desktop\\Sandbox\\rawdata.txt", "TSV"]; Flatten[%]; (* remove the "" caused by the extra tabs in your data file *) DeleteCases[%, ""]; (* Reshape your data into an array with your required dimensions *) ArrayReshape[%, {308, 508}]; (* ...


3

Because the data in the text file has one column, importing using the "Table" format produces a nested N × 1 array, where N is the number of lines in the file. Instead, use the "List" import format, and you will get a one-dimensional array: Import["D:/Data/Mathematica/Convert_data/rawdata.txt", "List"] should give {1.59867, 1.57057, 1.60027, 1.51327, ...


2

FirstPosition allows for a default value: sizeFunc[a | b | d | e | f] = {1, 1}; sizeFunc[c] = {2, 3}; list = {a, b, c, d, e, f}; FirstPosition[list, _?(sizeFunc[#] != {1, 1} &), {Length @ list}] {3} sizeFunc[c] = {1, 1}; FirstPosition[list, _?(sizeFunc[#] != {1, 1} &), {Length @ list}] {6} Without FirstPosition one might use: ...


2

I'll define a sizeFunc to play with: Clear[sizeFunc] sizeFunc[a] = {1, 1}; sizeFunc[b] = {1, 1}; sizeFunc[c] = {3, 2}; sizeFunc[d] = {2, 4}; sizeFunc[e] = {1, 1}; sizeFunc[f] = {1, 1}; UPDATE: OP mentioned the desired behavior when all elements return {1, 1}. Taking that into consideration, one can define the following function: firstnonscalar[l_List] ...


2

If your size function behaves something like this: sizeFunc[x_] := {1, 1} sizeFunc[d] := {3, 2, 1} then Select can get you the first element matching your negative criterion. Like this: Select[{a, b, c, d, e, f}, sizeFunc[#]!={1, 1} &, 1] If you want to use Position to get the position of the element in the list (rather than the element itself), ...


-1

This should work: Replace[{484/45, -16 EulerGamma/3, -8 Log[2], PolyGamma[0, 1/Sqrt[2]], (48/5 + 2 I/5) Sqrt[2] Log[1 + Sqrt[2]]}, _?ExactNumberQ -> 1, 2] (* {1, EulerGamma, Log[2], PolyGamma[1, 1/Sqrt[2]], Sqrt[2] Log[1 + Sqrt[2]]}*)


3

The fastest way is usually an assignment on Part, and it generalizes well. (See my comments in Elegant operations on matrix rows and columns.) A = {{1, 2, 3, 4}, {5, 6, 7, 8}, {9, 10, 11, 12}, {13, 14, 15, 16}}; B = A; B[[2 ;; 3, 2 ;; 3]] = 30; B // MatrixForm $\left( \begin{array}{cccc} 1 & 2 & 3 & 4 \\ 5 & 30 & 30 & 8 \\ 9 ...


9

a = {{1, 2, 3, 4}, {5, 6, 7, 8}, {9, 10, 11, 12}, {13, 14, 15, 16}} ReplacePart can be used with explicit positions b = ReplacePart[a, {{2, 2}, {2, 3}, {3, 2}, {3, 3}} -> 30] or with positions matching a pattern b = ReplacePart[a, {(2 | 3), (2 | 3)} -> 30] {{1, 2, 3, 4}, {5, 30, 30, 8}, {9, 30, 30, 12}, {13, 14, 15, 16}} or b = ...


2

The problem is with the behaviour of Set. Consider the following example: a = {1,2,3,4,5}; a[[2;;]] = {1,2,3,4} a[[3;;]] = {1,2,3,4} a[[4;;]] = {1,2,3,4} a[[5;;]] = {1,2,3,4} Notice that in the [[2;;]] part, Mathematica decides you want to replace elements 2, 3, 4 and 5 of a with the corresponding elements 1, 2, 3, 4 rather than all with the list ...


2

Since you changed the question completely and rendered every answer posted and the effort involved moot, here's a method to compute the exact PMF and Mean for your new formulation with nearly nil memory requirements. Since you've not responded to requests by me and others to clarify precisely what it is you're after, I don't plan on spending any time ...


5

If it's absolutely necessary to use the symbols as you've defined them, here's one option. (I've added FRH to the list to show that it doesn't get matched.) Cases[{RBI, RCD, ASD, FGH, FRH}, a_ /; StringMatchQ[ToString @ a, "R" ~~ ___]] results in {RBI, RCD} which is a list of Symbols (not a list of Strings). Now, there's a problem if you have already ...


3

Two people asked me to re-post a comment as a separate answer for greater visibility. Regarding Simon's Flatten method I commented: Worth noting is that despite being a single clean operation this is actually slower than Join @@ Transpose @ lists in most cases. Part of the reason that I "only" commented is that I had not invested the time necessary to ...


4

Although I'd rather prefer to have a few more test cases at hand, I'm posting this as an answer since you confirmed in your comments that this does what you need. test = {{1, 3}, {1, 4}, {1, 7}, {2, 1}, {3, 5}, {4, 1}, {5, 2}, {6, 1}, {7, 6}} par = List @@@ First@FindPostmanTour@Graph[DirectedEdge @@@ test] (* {{1, 3}, {3, 5}, {5, 2}, {2, 1}, {1, 4}, {4, ...


1

test1 = {{1, 3}, {1, 4}, {1, 7}, {2, 1}, {3, 5}, {4, 1}, {5, 2}, {6, 1}, {7, 6}}; f[{}] := {}; f[{a_, b_}] := Module[{c}, c = Cases[test1, {b, _}]; test1 = DeleteCases[test1, {a, b}, {1}, 1]; If[c == {}, c, test1 = DeleteCases[test1, {b, _}, {1}, 1]; First@c]]; test2 = {}; While[test1 != {}, AppendTo[test2, Flatten@FixedPointList[f, ...


1

Dirty code which does the job test = {{1, 3}, {1, 4}, {1, 7}, {2, 1}, {3, 5}, {4, 1}, {5, 2}, {6, 1}, {7, 6}}; UberChain = {}; While[Length[test] > 1, chain = {test[[1]]}; While[True, If[Last[Last[chain]] == First[First[chain]], Break[], AppendTo[chain, Select[test, #[[1]] == Last[Last[chain]] &][[1]]]]]; Do[test = DeleteCases[test, ...


1

If you think you will run into that ambiguity a lot you might want to define a function to carry out your calculation: Clear[matrixmult] matrixmult[m_?MatrixQ, v_?VectorQ] := v.m.v matrixmult[m_?NumberQ, v_?VectorQ] := v.(m IdentityMatrix[3]).v I used two conditional definitions: the correct definitions will be picked depending on the type of the ...


1

If you just want to track things for your own usage you could do something simple like this: lists = {a, b, c}; scalars = {p, q, r}; function[sym_] := Which[ MemberQ[lists, sym], "list", MemberQ[scalars, sym], "scalar", True, Head[sym]] function /@ {a, p, 0} {"list", "scalar", Integer} You ...


2

The following answer is effectively equivalent to m_goldberg's answer, except that the distinction between the two directions of movement has been eliminated: moveElement[l_List, m_Integer?Positive, n_Integer?Positive] := Module[{idx}, idx = Range @@ Sort[{m, n}]; ReplacePart[l, Thread[idx -> l[[RotateLeft[idx, Sign[n ...


3

Values works on both associations and a list of rules. Flatten@Values[thisVeryExcitingList] (* {1, 2, 3} *) You need to Flatten to remove the nesting from your original list. Hope this helps.


2

No idea if it's optimum, but: mylist = {{x -> 1}, {x -> 2}, {x -> 3}}; mylist /. Rule -> (#2 &) // Flatten (* {1,2,3} *) It helps a bit if you take a look at the full form of your expression: FullForm[mylist] (* List[List[Rule[x, 1]], List[Rule[x, 2]], List[Rule[x, 3]]] *) So the code above replaces 'Rule' with the unnamed function ...


3

Not really better but might be interesting: For versions >= 10.1 (* EDIT: previous definition: *) (* f[x_] := Abs@x f[x_Complex] := Null *) f[x_Real] := Abs@x f[x_] := Null then TakeSmallestBy[results, f@*Values@*First, 1] (*TakeSmallestBy[results, f[Values[First[#]]] &, 1]*) {{sf -> 390.825}} Explanation: TakeSmallestBycan deal with ...


6

data = {a, b, c, d, e, f}; Permute[data, {3, 1, 2}] or Permute[data, Cycles[{{1, 3, 2}}]] Both give {b, c, a, d, e, f} Edit It occurred to me that it would be good to be able to move an element to a lower position in the list as well as a higher one. Together the following two functions give both capabilities. Upward movement -- move an element ...


3

Probably not the most elegant way but... swap[list_, from_, to_] := Module[{ele = list[[from]], modlist = list}, modlist[[from]] = Sequence[]; modlist = Insert[modlist, ele, to]; modlist] swap[list, 1, 3] {b, c, a, d, e, f} If you always want the moving element in front of d... swap[list, 1, FirstPosition[list, d] - 1] Note, in 10.2 you ...


8

Perhaps not as clean as Michael's but I still like it: results // Cases[{_ -> _Real}] // MinimalBy[Abs@*Values] {{sf -> 390.825}}


2

Of course it depends on what you deem simpler, but here is my attempt that retains the transformation rule structure in the output, since you mention it in your question: First@SortBy[Select[results, Im[sf /. #] == 0 &], Abs[sf] /. # &] (* Out: {sf -> 390.825} *)


8

This is arguably "simpler": Nearest[Cases[results, _Real, Infinity], 0] (* {390.825} *) In case the rule matters, the above is easily adapted: Nearest[Cases[results, r : {_ -> x_Real} :> x -> r], 0] (* {{sf -> 390.825}} *)


2

You can use Inactivate with TraditionalForm. Inactivate[h = (R.omega + x).x] // TraditionalForm Inactivate prevents the operations from executing and TraditionalForm gives the formatted output. Hope this helps.


3

You can use repeated replacement, this will only keep elements that are strictly increasing. list = {1,2,3,4,6,5,7,8}; list = list//. {a___, x_, y_, b___} /; y < x :> {a, x, b} Which gives: {1, 2, 3, 4, 6, 7, 8} In the case that the all elements in Rest@list are less than the first element, a decreasing list for instance, it will return only ...


1

a = {1, 2, 5, 6, 8, 5, 4, 9, 12, 11}; Union@(Max /@ Table[Take[a, i], {i, Length[a]}]) (* {1, 2, 5, 6, 8, 9, 12} *)



Top 50 recent answers are included