Tag Info

New answers tagged

7

For your specific example. Assigining it to test. The InputForm: InputForm[test] is {Style[up, LineColor -> RGBColor[1, 0, 0], FrontFaceColor -> RGBColor[1, 0, 0], BackFaceColor -> RGBColor[1, 0, 0], GraphicsColor -> RGBColor[1, 0, 0], FontColor -> RGBColor[1, 0, 0]], right, up, Style[up, LineColor -> RGBColor[1, 0, 0], FrontFaceColor -> ...


6

Here's one way to resolve the CRLF problem. data = Import[fname, "Text"]; StringReplacePart[data, "\[Wolf]", StringPosition[data, "\n" ~~ DigitCharacter]]; StringReplace[%, "\n" -> ""]; StringReplace[%, "\[Wolf]" -> "\n"]; data2 = ImportString[%, "CSV"]; First, I import the file as a single text string. I notice in the file that all of the ...


6

I think that the existing comma-separated-values, fields, containing "new lines" are the offending elements in your file. If you do Length /@ Import["data.csv"] {64, 64, 64, 64, 64, 64, 1, 1, 25, 64, 64, 8, 1, 1, 1, 1, 1, 25, 7, 1, 1, 1, 1, 25, 1, 2, 2, 25, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, 64, ...


0

I'd use fs = Reap[Do[With[{n = n}, Sow[#^n &]], {n, 0, 10}]][[2, 1]] {#1^0 &, #1^1 &, #1^2 &, #1^3 &, #1^4 &, #1^5 &, #1^6 &, #1^7 &, #1^8 &, #1^9 &, #1^10 &} Your methods 2 & 3 don't work because Function has the attribute HoldAll and therefore m = 2; #^m & #1^m & With can be used "to ...


5

m = {{6.22926, 6.23254, 6.23128, 0, 6.23453, 6.22548, 6.22938, 6.23443, 0}, {6.22926, 6.23254, 6.23128, , 6.23453, 6.22548, 6.22938, 6.23443,}} Select[m, MatrixQ[{#}, NumericQ] &] {{6.22926, 6.23254, 6.23128, 0, 6.23453, 6.22548, 6.22938, 6.23443, 0}} more alternatives for speed comparisons.


9

The following should work: lis = {{1, 2, 3, 4, 5, 6}, {1, 9, , 4, 6, 2}, {4, a, 3, 7, 1, 2}, {3.4, 5.2, 6.5, 7.7, 6.1, 2}}; Then: Cases[lis, {__?NumericQ}] {{1, 2, 3, 4, 5, 6}, {3.4, 5.2, 6.5, 7.7, 6.1, 2}} We can also use VectorQ with Select Select[lis, VectorQ[#, NumericQ] &] If you have Version 10, the following works: ...


2

m = {{1, 2, 3}, {, 2, 3}, {1.1, 2, 3}, {1.1, , 3}} DeleteCases[m, Alternatives @@ Select[m, MemberQ[#, _?(Not[NumericQ[#]] &)] &]] {{1, 2, 3}, {1.1, 2, 3}} Edit A timing comparison. First creating a matrix:- m = RandomReal[1, {10000, 10000}]; (* Adding some blanks *) (m[[Sequence @@ #]] = "") & /@ RandomInteger[{1, 10000}, {2000, ...


3

To expand @eldo's answer a bit, you can fully replicate MaximalBy like this: Clear@myMaximalBy; myMaximalBy[e_List, f_, n_: All] := Take[Last@SortBy[GatherBy[e, f], #[[1, -1]] &], n]; Then SeedRandom@1; list1 = {{25, 16}, {1, 50}, {2, 8}, {13, 93}, {41, 21}}; list2 = RandomInteger[10, {100, 2}]; myMaximalBy[list1, Last] {{13, 93}} ...


4

MaximalBywas only introduced with V10 For V9 and prior use Last @ SortBy[{{25, 16}, {1, 50}, {2, 8}, {13, 93}, {41, 21}}, Last] {13, 93}


2

If you're using Mathematica 10, you can also use the new Association feature: frame = Association[]; frame[1] = (*picture1*); frame[2] = (*picture2*); In some ways, associations behave more like lists than downvalues: for example, functions like Map and Select work on them directly. If you assign a different variable to an association, you'll get a copy ...


6

You need to select a new data structure. As Leonid Shifrin has written Append[list, element] has a complexity proportional to Length[list] while Append[association, key -> value] is roughly constant time. Another data structure with this same property is linked lists: {newImage, {prevImage, {prevPrevImage,{}}} Any of these two could be used for ...


4

Here's how I'd approach it. Basically, use DownValues and DumpSave: frame[1] = (*picture1*); frame[2] = (*picture2*); DumpSave["filepath.mx",frame] With a fresh Kernel: Get[filepath.mx]; Length@DownValues@frame 2 Also, Obligatory warning about DumpSave: It's platform and version specific.


2

A faster variant of Seismatica's answer: List @@ StringReplace[StringJoin[ToString /@ list], "100" -> {Style[1, Red], Style[0, Red], Style[0, Red]}] /. x_String :> Table[0, {StringLength@x}] // Flatten Here' s a time table running the functions 100 times over a random 0 | 1 list with 1000 members:


4

Another version which will take more general specs, though performance is not great: ragged[l_, dims_] := Module[{x = l}, dims /. {n__Integer} :> ArrayReshape[x, x = Drop[x, 1 n]; {n}]] e.g. ragged[Range[20], {{{2, 3}, {2, 4}}, {2, 3}}] (* { {{{1, 2, 3}, {4, 5, 6}}, {{7, 8, 9, 10}, {11, 12, 13, 14}}}, {{15,16, 17}, {18, 19, 20}} } ...


5

Here is my contribution: a performance improvement upon WReach's method. Extracting entire rows at a time can be considerably faster with hopefully a minimum of obfuscation. fn[source_, dims_] := Module[{i = 0}, source ~Take~ {i + 1, i += #2} ~Table~ {#} & @@@ dims ] Test: fn[Range@19, {{2, 3}, {4, 1}, {3, 3}}] // Column {{1,2,3},{4,5,6}} ...


10

I think you want Permutations: Permutations[{1, 2, 3}, {2}] {{1, 2}, {1, 3}, {2, 1}, {2, 3}, {3, 1}, {3, 2}}


9

Here is a semi-imperative way: result = Module[{i = 1}, Array[myflatarray[[i++]]&, #]& /@ mydimensions]; result === original (* True *) It uses Array to build up each of the original submatrices, taking successive elements from the flat array.


6

Modifying halirutan's unflatten and Ray Koopman's copyPartition that appeared in this Q/A unflatten2[a_, dims_] := Module[{i = 1, b = Map[ConstantArray[0, #] &, dims, {-2}]}, Function[Null, a[[i++]], {Listable}][b]]; copyPartition2[a_, dims_] := Module[{i = 0, b = Map[ConstantArray[0, #] &, dims, {-2}]}, ...


11

Here is a version which is quite general, and based on Mr.Wizard's dynP function: dynP[l_, p_] := MapThread[l[[# ;; #2]] &, {{0}~Join~Most@# + 1, #} &@Accumulate@p] ClearAll[tdim]; tdim[{dims__Integer}] := Times[dims]; tdim[dims : {__List}] := Total@Map[tdim, dims]; ClearAll[pragged]; pragged[lst_, {}] := lst; pragged[lst_, dims : {__Integer}] ...


10

MapThread[ Partition, {Internal`PartitionRagged[myflatarray, Times @@@ mydimensions], mydimensions[[All, 2]]} ] Internal`PartitionRagged is undocumented. An example of how it works is: Internal`PartitionRagged[{1,2,3,4,5},{3,2}] (* Out: {{1,2,3},{4,5}} *)


3

Not sure if this is faster but here it goes: Module[{accumulateLength, subMatrices}, accumulateLength = Accumulate[Times @@@ mydimensions]; subMatrices = MapThread[myflatarray[[#1 ;; #2]] &, {Prepend[Most[accumulateLength] + 1, 1], accumulateLength}]; MapThread[Partition[#1, #2] &, {subMatrices, Last /@ mydimensions}]] The step to generate ...


2

Maybe this is faster: par[arr_, dim_] := Module[{x = Last /@ dim, y = First /@ dim, l1 = Length @ arr, l2, a}, { a = Take[Partition[arr, y[[1]]], x[[1]]], a = Take[Partition[Take[arr, (l2 = Length @ Flatten @ a) - l1], y[[2]]], x[[2]]], Partition[Take[arr, l2 + Length @ Flatten@a - l1], y[[3]]] }]; par[myflatarray, {{4, 5}, {3, 4}, {2, 3}}] ...


5

I think those who find this kind problem challenging enough to ask for s solution on this site are likely to be open to a tutorial answer giving a step-by-step exposition. The overall plan is to develop a function that will take one item from the table, compute the date difference for that item, and insert it into the item. With such a function, any data ...


5

My proposal: {##, data[[1, 1]] ~DayCount~ #} & @@@ data {{{2012, 6, 1}, 16, 0}, {{2012, 6, 8}, 14.24, 7}, ..., {{2012, 10, 9}, 4.53, 130}}


1

data /. {date_: {_, _, _}, v_} :> {date, v, DateDifference[{2012, 6, 1}, date]} {{{2012, 6, 1}, 16, Quantity[0, "Days"]}, {{2012, 6, 8}, 14.24, Quantity[7, "Days"]},... If you are using V10 you need to use QuantityMagnitude to get the number of days as a number. This goes for all answers using DateDifference. data /. {date_: {_, _, _}, v_} :> ...


2

{## & @@ #, DateDifference[data[[1, 1]], First@#]} & /@ data (* {{{2012, 6, 1}, 16, 0}, {{2012, 6, 8}, 14.24, 7}, {{2012, 6, 15}, 13.7, 14}, {{2012, 6, 22}, 12.31, 21}, {{2012, 6, 29}, 11.5, 28}, {{2012, 7, 6}, 10.08, 35}, {{2012, 7, 13}, 9.18, 42}, {{2012, 7, 20}, 8.65, 49}, {{2012, 7, 27}, 7.8, 56}, {{2012, 8, 3}, 7.51, 63}, ...


4

DateDifference[First@First@data, #] & /@ (First /@ data) Append[#, #2] & @@@ Thread@{data, %} {0, 7, 14, 21, 28, 35, 42, 49, 56, 63, 70, 77, 84, 91, 98, 105, 112, 119, 126, 130} {{{2012, 6, 1}, 16, 0}, {{2012, 6, 8}, 14.24, 7}, {{2012, 6, 15}, 13.7, 14}, {{2012, 6, 22}, 12.31, 21}, {{2012, 6, 29}, 11.5, 28}, {{2012, 7, 6}, 10.08, 35}, {{2012, ...


8

Another functional approach using the Flat attribute: (Credit to Mr Wizard for the clever form of the second line) SetAttributes[f, Flat]; f[1, 0, 0] = Style[#, Red] & /@ f[1, 0, 0]; List @@ f @@ list


3

I keep on thinking how ListCorrelate sounds ideal for this but can't find a way. A functional way (but still slower) would be: g[g[b__], d_] := g[b, d]; g[a___, 1, 0, 0] := Sequence[a, Sequence @@ (Style[#, Red] & /@ {1, 0, 0})] and then using Fold: List @@ Fold[g, First@list, Rest@list] ---EDIT--- which, after Mr Wizard's recommendation, can ...


7

Using highlight from my answer to Formatting text through pattern matching: ToString[list] /. highlight["1, 0, 0", Style[#, Red] &]


5

Using string manipulations seems to speed things up significantly: randomList = RandomInteger[{0, 1}, 1000]; m1 = randomList //. {b___, PatternSequence[1, 0, 0], a___} -> {b, Sequence @@ (Style[#, Red] & /@ {1, 0, 0}), a} // AbsoluteTiming; m2 = StringSplit[StringJoin @@ (ToString /@ randomList), "100" -> Sequence @@ (Style[#, ...


5

list /. (0) :> Style[0, Red]


4

I don't think there's any built-in function to do this, but here is an alternative: myFunc[func_, data_] := Transpose[Through[func[#]] & /@ data] Then myFunc[{f, g, h}, {a, b, c}] {{f[a], f[b], f[c]}, {g[a], g[b], g[c]}, {h[a], h[b], h[c]}}


5

Update Well I guess I should retire for the evening to a less brain-intensive activity as apparently I can't think clearly. One could of course use Outer: Outer[Compose, {f, g}, {a, b, c}] {{f[a], f[b], f[c]}, {g[a], g[b], g[c]}} However I recommend that you do not do this as you will not gain the auto-compilation of Map, meaning this method will ...


3

LogPlot[] is trying to symbolically manipulate your f[], and the Part[] function fails at that. You may try to specify that your function should be evaluated only for numerical input, but not symbolically: lst := {5, 10, 20} f[m_?NumericQ] := lst[[Floor[m/10]]]; LogPlot[f[x], {x, 10, 38}]


4

Yes, it is possible to generate sublists with more than one element. For example: Last @ Reap[ Sow[1,a]; Sow[2,a] ; Sow[3,b]; Sow[4,b] ; Sow[5,c]; Sow[6,c] ; Sow[7,d]; Sow[8,d] , {a|b, c|d} ] (* {{{1, 2}, {3, 4}}, {{5, 6}, {7, 8}}} *) The documentation explains that this happens because "Expressions sown using [...] different tags are given in ...


3

The form of Reap your using is Reap[expr, p:{pat1, pat2, ...}] where each pattern generates a separate list in the answer. For instance, from the docs, Reap[ Sow[1, RandomInteger[{-9, 9}, 100]], {_?Negative, _?NonNegative}, #1 -> Total[#2] & ] // Last (* { {-1 -> 4, -3 -> 5, -2 -> 5, -9 -> 6, -4 -> 4, -7 -> 3, -8 -> 3, ...


5

ReplacePart If one is willing to bend on the requirement to use MapIndexed, ReplacePart can generate the desired output directly: $list = {a, {b, {c^d, {e + f g}}}}; ReplacePart[$list, {i:PatternSequence[2..., 1]} :> h[$list[[i]], {i}]] (* {h[a, {1}], {h[b, {2, 1}], {h[c^d, {2, 2, 1}], {h[e + f g, {2, 2, 2, 1}]}}}} *) MapIndexed Alternatively, we ...


10

Interesting question. Here is my proposal: fn[f_, expr_] := Module[{h}, h[x_List, _] := x; h[o_[x__h], i_] := h[o @@ {x}[[All, 1]], i]; MapIndexed[h, expr, {1, -1}] /. h -> f ] Test: fn[h, {a, q Sqrt[r], {{{e + f g h}, c^d}, b}}] {h[a, {1}], h[q Sqrt[r], {2}], {{{h[e + f g h, {3, 1, 1, 1}]}, h[c^d, {3, 1, 2}]}, h[b, {3, 2}]}} I ...


9

May be this is not the smarter way to do it but here is what I got: l = {a, {b, {c^d, {e + f g}}}}; pos = ReplaceAll[(Position[l, List]), 0 -> 1]; h[l[[Sequence @@ #]], #] & /@ pos (*{h[a, {1}], h[b, {2, 1}], h[c^d, {2, 2, 1}], h[e + f g, {2, 2, 2, 1}]}*) If you want to keep the levels as they are then: rule = Rule[#, h[l[[Sequence @@ #]], #]] ...


9

What you have is a so called linked list, and such lists are usually traversed through recursion like this: applyFunc[f_, {el_, rest_}, level_: {1}] := {f[el, level], applyFunc[f, rest, Prepend[level, 2]]} applyFunc[f_, {el_}, level_] := {f[el, level]} applyFunc[h, expr] {h[a, {1}], {h[b, {2, 1}], {h[c^d, {2, 2, 1}], {h[e + f g, {2, 2, 2,1}]}}}} But ...


9

In Mathematica 10, this computation may be made as follows: Clear @ r volSphere9[r_] = RegionMeasure[Ball[ConstantArray[0, 10], r]] (π^5 r^10)/120 volSphere9[1000.] 2.55016*10^30


7

The sum of the squares should be less than or equal to r^2 rather than r. d = 10; r = 1000; F = Piecewise[{{1, Sum[x[i]^2, {i, d}] <= r^2}}, 0]; NIntegrate[F, {x[1], -1000, 1000}, {x[2], -1000, 1000}, {x[3], -1000, 1000}, {x[4], -1000, 1000}, {x[5], -1000, 1000}, {x[6], -1000, 1000}, {x[7], -1000, 1000}, {x[8], -1000, 1000}, {x[9], -1000, 1000}, ...


0

I don't know why, but replacing Switch with nested If solved the problem of leaking memory.


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



Top 50 recent answers are included