Tag Info

New answers tagged

5

MapIndexed[Print[Row[{First@#2, #1}, ","]] &, {2, 5, 7}]; 1,2 2,5 3,7 Or simpler: MapIndexed[Print[First@#2, ",", #1] &, {2, 5, 7}] 1,2 2,5 3,7


6

A scan operation doesn't really have an index, but you can get the effect you want by introducing a counter. Module[{i = 0}, Scan[(i++; Print[i, ", ", #]) &, {2, 5, 7}]] You might also consider using Do, which does have an index. With[{data = {2, 5, 7}}, Do[Print[i, ", ", data[[i]]], {i, Length @ data}]]


2

@Mr.Wizard s = StringReplace["{{a},{b,c,d},{e,{[f],{g}}}}", x : Except["{" | "," | "}"] .. :> "\"" <> x <> "\""] // ToExpression check = If[SyntaxQ@#, ToExpression@#, #] &; ReplaceAll[s, x_String :> check@x] // InputForm (*out*) {{a}, {b, c, d}, {e, {"[f]", {g}}}}


4

Well I just saw your comment that says you want "all strings" so perhaps a different approach: StringReplace["{{a},{b,c,d},{e,{[f],{g}}}}", x : Except["{" | "," | "}"] .. :> "\"" <> x <> "\""] // ToExpression {{"a"}, {"b", "c", "d"}, {"e", {"[f]", {"g"}}}} If that doesn't work consider manipulating the raw box format produced by ...


2

From your updated example this does what you desire: N[f.t2.rx.t1.#] & /@ points { {{100.}, {29.2893}, {0.}, {1.}}, {{155.}, {29.2893}, {0.}, {1.}} } You can eliminate some redundancy by precomputing the fixed part of that operation: m = f.t2.rx.t1; N[m.#] & /@ points { {{100.}, {29.2893}, {0.}, {1.}}, {{155.}, {29.2893}, {0.}, {1.}} ...


0

Inspired by @Mr.Wizard's answer. This should work with both numbers and symbols: ClearAll[elementDisplay] SetAttributes[elementDisplay, HoldAll] elementDisplay[f_[arg__List]] := f @@ Function[x, Defer[x], Listable]@{arg} // MatrixForm elementDisplay[{{1, 2}, {a, b}}.{{5, 6}, {c, d}}] ClearAll[listOpDisplay] SetAttributes[listOpDisplay, HoldAll] ...


0

Here the answer for @Luiz Roberto Meier, which was closed although it was no duplicate, but needed some deeper reflections. First, ContourPlot doesn't show the complete solution. This plot is complex-valued, therefore you may use Re and Im So, the extraction of the plotpoints in ContourPlot won't be very useful, but as already suggested it might be done ...


1

Try this: Map[{t1.#, rx.#, t2.#} &, points] or like this: Map[{t1, rx, t2}.# &, points] which is the same. For example, if points = {{a1, a2, a3}, {b1, b2, b3}}; and t1 = {x, 0, 0}; rx = {0, y, 0}; t2 = {0, 0, z}; the operation yields: Map[{t1.#, rx.#, t2.#} &, points] (* {{a1 x, a2 y, a3 z}, {b1 x, b2 y, b3 z}} *) as ...


2

The previous answers all use Inner to perform the specific operation of Dot, but these do not provide a general way to visualize results. I cannot provide a truly general way either but I feel that this has wider application: SetAttributes[show, HoldFirst] form[expr_] := expr /. m_ /; MatrixQ@Unevaluated@m :> MatrixForm[m] show[expr_] := ...


4

Either of the following, taken from the comments, will work. kguler's answer. NMinimize[{a + 1, {Or @@ (a == #& /@ {-1, 0, 2}) && a > 0}}, a] belisarius' answer. NMinimize[{a + 1, Times @@ ((a - #)& @ {-1, 0, 2}) == 0}, a]


3

This is not an answer, but, based on chuy's solution, I want to show one of the advantages of the new V10 Inactive: (x = Inner[Inactive[Times], {{1, 2}, {3, 4}}, {{5, 6}, {7, 8}}, Inactive[Plus]]) // MatrixForm Activate[x, Times] // MatrixForm Activate[x] // MatrixForm


4

For version 9 (and possibly older versions), you can use Inner[Composition[Defer, Times], {{1, 2}, {3, 4}}, {{5, 6}, {7, 8}}] // MatrixForm or Inner[Defer[Times@##] &, {{1, 2}, {3, 4}}, {{5, 6}, {7, 8}}] // MatrixForm or Inner[Composition[HoldForm, Times], {{1, 2}, {3, 4}}, {{5, 6}, {7, 8}}] // MatrixForm to get


7

This might be "too direct" an answer, but you can try: Inner[Inactive[Times], {{1, 2}, {3, 4}}, {{5, 6}, {7, 8}}, Inactive[Plus]] // MatrixForm $\left( \begin{array}{cc} 1*5+2*7 & 1*6+2*8 \\ 3*5+4*7 & 3*6+4*8 \\ \end{array} \right)$


0

I tried another alternative using Replace with {0, Infinity} levelspec and it was surprisingly faster than ReplaceAll in the other answer. replace = Replace[#, {p___, {a, x1_}, {b, x2_}, {c, x3_}, {d, x4_}, q___} -> {p, {"abcd", x1, x2, x3, x4}, q}, {0, Infinity}] &; replace[list2] (* {{e, {"abcd", 0.1, 0.3, 0.5, 0.7}, f, {{"abcd", 0.2, 0.4, ...


4

Level really has nothing to do with the problem you are experiencing; ReplaceAll already works equivalently at all levels, following a depth-first preorder traversal. Instead your problem is that the section of the expression that you wish to replace is not self-contained in list2. In list1 it is complete: {{a, 0.1}, {b, 0.3}, {c, 0.5}, {d, 0.7}} In ...


1

list2 = {{e, {a, 0.1}, {b, 0.3}, {c, 0.5}, {d, 0.7}, f, {{a, 0.2}, {b, 0.4}, {c, 0.6}, {d, 0.8}}, g, h, i}}; list2 /. {e, head__, f , tail__} :> {e, {head}, f, tail} /. {{a, x1_}, {b, x2_}, {c, x3_}, {d, x4_}} :> {"abcd", x1, x2, x3, x4} {{e, {a, 0.1}, {b, 0.3}, {c, 0.5}, {d, 0.7}, f, {"abcd", 0.2, 0.4, 0.6, 0.8}, g, h, i}}


3

First of all read a help. It's say: Interpolation[{{{x1, y1, ...}, f1}, {{x2, y2, ...}, f2}, ...}] constructs an interpolation function of multidimensional data. Your data have form {{x1, y1, f1}, {x2, y2, f3}, ...}. We need to change structure of data and then intepolate it f = Interpolation[lst /. {x_, y_, z_} :> {{x, y}, z}, InterpolationOrder ...


1

For completeness sake, another solution: str = "1,2,3,5,10,12,13,17,26,30,32,41,42,43,113,115,121,125"; FromDigits /@ StringSplit[str, ","]


6

Let's use the Titanic dataset tit = ExampleData[{"Dataset", "Titanic"}]; Let's see it's columns tit[Union, Keys] Let's choose an objective obj = "survived"; Let's add an id to each row tit = tit[AssociationThread[Range@Length@#, #] &]; Let's create a database that splits the features and objective, to make this general. titSplit = ...


1

f[a_, b_, c_] = a + b + c; list = {2, 3}; f[a, Sequence @@ list] (* 5 + a *)


2

Suppose you have your data stored in data, you can clean up the unwanted stuff using Cases: newdata = Cases[data, {{__?NumericQ}, _}]; Then use DateListPlot to plot it: DateListPlot[newdata]


1

Suppose you have a Excel like this: The best way to import excel is through SemanticImport.(In version 10.0.0.0) mydata = SemanticImport["d:/1.xlsx"] and you will get In my computer, Mathematica does not Process Date properly,So I did this: date = Normal@mydata[All, 1]; date = StringCases[#, WordCharacter ..] & /@ date date = ...


0

(* Import your data from the Excel file *) originalData = Import["your file name here"]; (* This checks to see if the data in the first column has been broken into a 6 part list and if the data in the second column is numeric; the Select function will return items that match both criteria*) cleanData = Select[originalData, Length[#[[1]]] == 6 && ...


1

lets say your import data are rawdata = {{"Unidad Indexada", ""}, {"Período Junio 2002 -", ""}, {"", ""}, {"", "Valor"}, {"Fecha", "Pesos ($)"}, {"", ""}, {"", ""}, {"2 0 0 2", ""}, {"", ""}, {"Junio", ""}, {"", ""}, {{2002, 6, 1, 0, 0, 0.}, 1.}, {{2002, 6, 2, 0, 0, 0.}, 1.0004}, {{2002, 6, 3, 0, 0, 0.}, 1.0008}, {{2002, 6, 4, 0, 0, 0.}, 1.0012}, ...


2

foo = {{{100, 25}, {150, 45}}, {{200, 45}, {240, 85}}}; Manipulate[ Graphics[{Line@#, Blue, Rotate[Line@#, t, Mean@#], Transparent, Circle[Mean@#,EuclideanDistance @@ #/2]} & /@ foo], {t,0, 2 Pi}] The transparent circles are there to pre-calculate the maximum Plot Range.


4

grF := Function[{angle}, Graphics[{Thick, Dashed, Black, Line@#, Red, GeometricTransformation[Line@#, RotationTransform[angle, Mean@#]], Black, PointSize[Large], Point[Mean@#], Text[ToString[Mean@#], Mean@# + 2]} & /@ #] &] grF[Pi/2]@foo ...


2

1: lines = {{{100, 25}, {150, 45}}, {{200, 45}, {240, 85}}}; f[{p1_, p2_}, theta_] := Module[{mid}, mid = (p2 - p1)/2 + p1; RotationTransform[theta, mid][#] & /@ {p1, p2} ]; lines2 = f[#, Pi/6] & /@ lines; Graphics[{Red, Line[lines], Blue, Line[lines2]}] 2: lines = {{{100, 25}, {150, 45}}, {{200, 45}, {240, 85}}}; lines2 = ...


4

With V10 one can also do str = "4.5e2, 0.08, 5, 10"; Interpreter[DelimitedSequence["Number"]][str] // Flatten {450., 0.08, 5, 10} Or even str = "4.5e2, 0.08, 5, 10, one, one divided by forty-eight"; Interpreter[DelimitedSequence["SemanticExpression"]][str] // Flatten //InputForm {450., 0.08, 5, 10, 1, 1/48}


2

First, how you would you find the critical points of a function, say $f(x)=x^3-x$, from scratch? I guess you might write D[x^3 - x, x] (* Out: 3x^2 - 1 *) Then, you want to know when that's equal to zero. So you might type Solve[% == 0, x] (* Out: {{x -> -(1/Sqrt[3])}, {x -> 1/Sqrt[3]}} *) where the % sign refers to the previous output. Now ...


1

Two small changes make this work in a much nicer way: First, the use of NDSolveValue instead of NDSolve gets rid of this rule replacement monkey business. {tini, tfin} = {-Log[100], 0}; firstFuncK = NDSolveValue[{D[f[t, k], t] + f[t, k]^2 + (1 - t)*f[t, k] == 3/2*(1 + k^2), f[tini, k] == 1}, f, {t, tini, tfin}, {k, 0.001, 10}] (* ...


2

Here my proposition Maybe the best format in this case is "CSV" (also "Table" would be interesting ) You'll have to customize myPath and "material.txt" myPath = NotebookDirectory[]; file = ToFileName[myPath, "material.txt"] f = Import[file, "CSV"] once the file is loaded, it appears without quotes in Mma (I saved it previously in the actual directory ...


2

I have to post a separate answer because my approach in this one is very different from my other answer's. It is based largely on the method that Frank Kampus used here to solve a sudoku, using Backtrack from the Combinatorica package in one method, and Outer/Select in the other method. Warning: it's a long answer. I managed to solve the puzzle but only ...


2

Below is my (unsuccessful) attempt at solving the problem. I think this is an interesting problem that the MMA experts on here could help solve, and in the process will hopefully reveal the capabilities of MMA. 1) I borrowed from the answer in the linked Q&A the fact that the total of all elements in the matrix will be 468. This means that the row ...


1

I worked out a solution using Position and a Table of Set's i.e. "set x at this position to the numbered variable with the same index i". I really appreciate all of your answers, and hopefully I will get used to using ++i in the future. Clear[replacex] replacex[l_List] := Module[{lCopy = l, positionx, numberedx}, positionx = Position[l, "x"]; numberedx ...


4

Another way: Module[{i = 0, l = #, f}, f[x_String] := Symbol[x <> ToString[++i]]; f[x_] := x; Map[f, l, {2}]] &@list {{0, x1, x2, 0}, {0, x3, x4, x5}, {0, x6, x7, x8}, {x9, x10, x11, x12}, {x13, x14, x15, x16}, {x17, x18, x19, x20}, {x21, x22, x23, x24}, {x25, x26, x27, x28}, {0, x29, x30, x31}}


5

Pickett's answer should get the job done but I encourage you to use indexed objects: Module[{i = 0}, list /. s_String :> x[++i] ]


6

ReplaceAll solution: i = 1; list /. "x" :> Symbol@StringJoin["x", ToString[i++]] The same thing can be achieved with Map: i = 1; Map[If[# == "x", "x" <> ToString[i++] // Symbol, #] &, list, {2}] They both give: {{0, x1, x2, 0}, {0, x3, x4, x5}, {0, x6, x7, x8}, {x9, x10, x11, x12}, {x13, x14, x15, x16}, {x17, x18, x19, x20}, {x21, ...


2

My interpretation of what you want. These are equivalent; take your pick for readability or flexibility. list /. {x_, a : {__List}} :> Thread @ {Array[x, Length@a], a} list /. {x_, a : {__List}} :> Array[{x[#], a[[#]]} &, Length @ a] list /. {x_, a : {__List}} :> MapIndexed[{x[First @ #2], #} &, a] {{a, {1, 2, 3}}, {b, {1, 2, 4}}, ...


5

Here is the solution proposed by Kuba, I just deleted the second part of list since it has no use here. list = {{a, {1, 2, 3}}, {c, {{1, 4, 5, 5}, {6, 3, 2, 1}}}}; list /. {s_, x : {__List}} :> (## & @@ Table[{Symbol[SymbolName[s] <> ToString[i]], x[[ i]]}, {i, Length@x}]) And here is an attempt to explain it: list = {{a, {1, 2, 3}}, ...


9

Update The problem is subtler than my first analysis revealed. There is indeed a problem with the variable et in NIntegrate not being properly blocked. Part of the problem has to do with the extra braces in firstFuncK which has the form {{f -> InterpolatingFunction[<>]}} Somehow that leads to an evaluation of et in the integrand f[et, k] /. ...


2

Since I cannot explain Kuba's elegant solution here is a step for step approach to your problem: list = {{a, {1, 2, 3}}, {b, {1, 2, 4}}, {c, {{1, 4, 5, 5}, {6, 3, 2, 1}, {7, 4, 5}}}}; Find the position of the last symbol (c): p = First@Last@Position[list, s_Symbol /; s =!= List] 3 (Since List is a Symbol I excluded it in the above statement). Now ...


1

x = y = RandomReal[1, 100]; p = Position[Differences@x, n_Real /; n > 0.1] + 1 // Flatten; Table[y[[n]] = (y[[n - 1]] + y[[n + 1]])/2, {n, {p}}]; ListLinePlot[{x, y}, ImageSize -> 600, PlotLegends -> {"original", "substituted"}]


0

Perhaps something along the following lines? data = {{27.342, -0.01}, {27.443, -0.03}, {27.546, -0.01}, {27.743, -0.01}, {27.945, -0.01}, {28.145, -0.03}, {28.246, -0.05}, {28.346, -0.06}, {28.547, -0.01}, {28.747, -0.01}, {29.149, -0.01}, {29.249, 0}, {29.45, -0.01}, {29.651, -0.05}, {29.852, -0.05}, {30.053, -0.01}, ...


0

For example, modifying data if first value is > -0.2 :- data = {{27.342, -0.01}, {27.443, -0.03}, {27.546, -0.01}, {27.743, -0.01}, {27.945, -0.01}, {28.145, -0.03}, {28.246, -0.05}, {28.346, -0.06}, {28.547, -0.01}, {28.747, -0.01}, {29.149, -0.01}, {29.249, 0}, {29.45, -0.01}, {29.651, -0.05}, {29.852, -0.05}, {30.053, -0.01}, {30.153, ...


2

Attempt from question : Mutable and immutable approach mixed up (not working) As Mr.Wizard pointed out, there is a mutable approach and an immutable approach. In the first case you modify y directly. In the second case the program returns a whole new vector, and you assign y the value of this vector. In the question you mix the two approaches, because you ...


3

Assuming I follow what you are doing I believe this may be the simplest correction: red = {{{-4, 50}, {100, 136}}, {{-19, 1}, {35, 73}}, {{-24, 0}, {26, 63}}}; y = {{0.01497, 1}, {0.04304, 3}, {0.07111, 2}, {0.09918, 1}}; red = Interval @@@ red; Do[ If[ y[[i, 1]] <= 0.05, xii = y[[i, 2]]; If[IntervalMemberQ[red[[xii]], 47], y[[i, 1]] = 999.]; ], ...


2

Thread[{RandomSample[community[[#]], cant[[#]]], #}] & /@ Range[Length[community]] (* {{{2, 1}, {3, 1}, {5, 1}, {1, 1}, {4, 1}}, {{3, 2}}, {{2, 3}, {4, 3}}, {{3, 4}, {2, 4}, {1, 4}}, {{3, 5}, {5, 5}, {4, 5}, {1, 5}}} *)


2

{(community[[#]]~RandomSample~1)[[1]], #} & /@ ConstantArray[#, cant[[#]]] & /@ Range[Length@cant]


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 ...


5

MapThread[Thread[List[RandomChoice[#1, #2], #3]] &, {community, cant, Range@Length@cant}] (* {{{2, 1}, {1, 1}, {3, 1}, {4, 1}, {6, 1}}, {{3, 2}}, {{4, 3}, {1, 3}}, {{2, 4}, {3, 4}, {1, 4}}, {{2, 5}, {3, 5}, {1, 5}, {6, 5}}} *) Some variations: MapIndexed[Thread[List[#1, First@#2]] &, MapThread[RandomChoice[#1, #2] &, {community, cant}]] ...



Top 50 recent answers are included