Tag Info

Hot answers tagged

7

triplesF = Partition[Flatten[Table[{i, j, k}, {i, 0, #}, {j, 0, If[i == #, #2, i]}, {k, 0, If[i == #, Min[j, #3], j]}]], 3] &; Examples: (* {{0, 0, 0}, {1, 0, 0}, {1, 1, 0}} *) triplesF[1, 1, 1] (* {{0,0,0},{1,0,0},{1,1,0},{1,1,1}} *) triplesF[2, 1, 0] (* {{0, 0, 0}, {1, 0, 0}, {1, 1, 0}, {1, 1, 1}, {2, 0, 0}, {2, 1, 0}}*) triplesF[2, 2, 0] ...


5

ClearAll[swapF] swapF = Module[{m1 = #, m2 = #2, k = Floor[Length[#]/2]}, Module[{copy = #, rows = Join @@ {Range[k], Range[k + 2, 2 k + 1]}}, CompoundExpression[copy[[rows, ;; k]] = #2[[rows, ;; k]], copy[[k + 1, k + 1 ;;2k]] = #2[[k + 1, k + 1 ;;2k]]]; copy] & @@@ {{m1, m2}, {m2, m1}}] &; Example: mat1 = ...


5

With[{maxR = 10}, Manipulate[ expr = Sqrt[R^2 - zeta^2] - zeta Tan[zeta]; zero = zeta /. NSolve[{expr == 0, R^2 - zeta^2 >= 0}, zeta] // Quiet; Column[{ Plot[expr, {zeta, -maxR, maxR}, Exclusions -> {Cos[zeta] == 0}, PlotRange -> {{-maxR, maxR}, {-25, 40}}, Epilog -> {Red, AbsolutePointSize[4], Point[{#, 0} ...


5

Sequence is treated a bit specially. It does not get "evaluated to a result", but instead as the documentation explains: Sequence objects will automatically be flattened out in all functions except those with attribute SequenceHold or HoldAllComplete. This means that even though If has attribute HoldRest, the expression If[1 == 0, x, Sequence[]] will ...


5

idtz = Internal`DeleteTrailingZeros; trim0a = With[{t = Reverse/@ idtz/@DeleteCases[#, ConstantArray[0, Length@#[[1]]]]}, Reverse /@ idtz /@ t] &; trim0b = With[{t = DeleteCases[#, ConstantArray[0, Length@#[[1]]]]}, Fold[idtz@#2@# &, #, {Reverse, Reverse}] & /@ t] &; Equal @@ (#@test & /@ {trim0, trim0a, ...


4

2nd list: Transpose[{{a1, b1}, {a2, b2}, {a3, b3}, {a4, b4}}] 1st list can be transformed into the second list and then handled the same way: Transpose[Partition[{a1, b1, a2, b2, a3, b3, a4, b4}, 2]] It can also be done with Part ([[ ]]): l1 = {{a1, b1}, {a2, b2}, {a3, b3}, {a4, b4}}; {l1[[All, 1]], l1[[All, 2]]} l2 = {a1, b1, a2, b2, a3, b3, a4, ...


4

l1 = {a1, b1, a2, b2, a3, b3, a4, b4} ; l2 = {{a1, b1}, {a2, b2}, {a3, b3}, {a4, b4}}; Transpose[ArrayReshape[#, {4, 2}]] &@l1 (* {{a1, a2, a3, a4}, {b1, b2, b3, b4}} *) Transpose[ArrayReshape[#, {4, 2}]] &@l2 (* {{a1, a2, a3, a4}, {b1, b2, b3, b4}} *) Also Flatten[l1][[# ;; ;; 2]] & /@ {1, 2} (* {{a1, a2, a3, a4}, {b1, b2, b3, b4}}*) ...


3

UPDATE Correcting my misunderstanding: c[n_, m_, l_] := With[{t = Sort@Tuples[Range[0, n], 3],crit = FromDigits[{n, m, l}, n]}, Rest@Pick[t,Reverse@Sort[#] == # && FromDigits[#, n] <= crit & /@ t]] So using kguler test cases: Grid[{#, c @@ #, Length[c @@ #]} & /@ {{2, 1, 0}, {2, 2, 0}, {3, 1, 0}, {3, 2, 0}}, Frame -> All] ...


3

A combination of Map, Function, and Slot will do it concisely: xsPoint[#] == rayPoint + d[#]*rayDirection & /@ {top, bottom, left, right, front, back} {xsPoint[top] == rayPoint + rayDirection d[top], xsPoint[bottom] == rayPoint + rayDirection d[bottom], xsPoint[left] == rayPoint + rayDirection d[left], xsPoint[right] == rayPoint + rayDirection ...


3

mat = {{{16, 2, 3, 13}, {5, 11, 10, 8}}, {9, 7, 6, 12}, {4, 14, 15, 1}, {{a, b, c}, {v, x, y}}}; mat2 = MapAt[## & @@ # &, mat, Position[mat, {{__}, {__}}]] (* {{16, 2, 3, 13}, {5, 11, 10, 8}, {9, 7, 6, 12}, {4, 14, 15, 1}, {a, b, c}, {v, x, y}} *) mat3 = FlattenAt[mat, Position[mat, {{__}, {__}}]] (* {{16, 2, 3, 13}, {5, 11, 10, 8}, ...


3

This answer only returns the period. If you want to extract the repeating substring, just use Take[list, period]. sequencePeriod = Compile[{{l, _Integer, 1}}, With[{n = Length[l]}, Catch[ Do[ If[ Catch[ Do[ Do[ If[l[[j]] != l[[k]], Throw[False]];, {k, i + j, n, i} ];, {j, i} ...


3

Sequence has non-standard evaluation rules. You can work around them like so. seq := Sequence {a, b, If[False, x, seq[]], c} {a, b, c} {a, b, If[True, x, seq[]], c} {a, b, x, c} Updated to conform with the observation made by Szabolcs in his comment below.


2

data = ToExpression@Import["~/Downloads/TI_1900_0.07_781.csv"]; process[raw_] := Module[{data, threshold}, data = raw[[;; -3]]; data = SortBy[data, First@*Last]; threshold = raw[[-2, 1]]; data = Select[data, #[[2, 1]] > threshold &]; BoxWhiskerChart[ data[[1 ;; 15, 1]] ] ] process[data] Note two things I've changed < into ...


2

Using the undocumented "Periodic" padding as the third argument of PadRight: ClearAll[fpF, fpF2] fpF = Block[{i = 1}, While[i < Length@# && PadRight[#[[;; i]], Length@#, "Periodic"] != #, i++]; i] &; fpF2 = Block[{i = 1}, While[i < Length@# && PadRight[#[[;; i]], Length@#, "Periodic"] != #, i++]; {i, #[[;; i]]}] ...


2

If the "Rows" are all same length (here 4): m = {{16, 2, 3, 13}, {{5, 11, 10, 8}, {9, 7, 6, 12}}, {4, 14, 15, 1}}; Partition[Flatten[m], 4] (* {{16, 2, 3, 13}, {5, 11, 10, 8}, {9, 7, 6, 12}, {4, 14, 15, 1}} *) Will be much more efficient...


2

You can replace Key[k] with #[[Key[k]]].


2

Like this? func[n_,m_,l_]:= Cases[ Tuples[{n, m, l}, 3], {x_, y_, z_} /; x >= y >= z && FromDigits[{n, m, l}, n] >= FromDigits[{x, y, z}, n] ] func[2,1,0] {{2, 1, 0}, {2, 0, 0}, {1, 1, 1}, {1, 1, 0}, {1, 0, 0}, {0, 0, 0}}


2

Dilation produces the same output as MaxFilter and has comparable speed. test = {5, 6, 9, 3, 2, 6, 7, 8, 1, 1, 4, 7}; Dilation[test, 1] (* {6, 9, 9, 9, 6, 7, 8, 8, 8, 4, 7, 7} *) It also has a Padding option which may be convenient: Dilation[test, 1, Padding -> 10] (* {10, 9, 9, 9, 6, 7, 8, 8, 8, 4, 7, 10} *) Dilation[test, 1, Padding -> ...


2

data= {{1891, 10, ""}, {1892, 38, ""}, {1897, 24, ""}, {1898, 16, ""}, {1903, 21, ""}, {1904, 26, ""}, {1905, 13, ""}, {1908, 48, "TRUE"}, {1908, 15, ""}, {1908, 34, ""}, {1908, 7, ""}, {1909, 7, ""}, {1909, 173, "TRUE"}, {1909, 27, "TRUE"}, {1909, 14, ""}, {1909, 77, ""}, {1909, 118, ""}, {1910, 136, ""}, {1910, 94, "TRUE"}, {1910, 7, ...


2

data = {{1891, 10, ""}, {1892, 38, ""}, {1897, 24, ""}, {1898, 16, ""}, {1903, 21, ""}, {1904, 26, ""}, {1905, 13, ""}, {1908, 48, "TRUE"}, {1908, 15, ""}, {1908, 34, ""}, {1908, 7, ""}, {1909, 7, ""}, {1909, 173, "TRUE"}, {1909, 27, "TRUE"}, {1909, 14, ""}, {1909, 77, ""}, {1909, 118, ""}, {1910, 136, ""}, {1910, 94, "TRUE"}, {1910, 7, ...


2

If I understand correctly, let say you have one x column and several f[x,y] column. For example I assume f1(x) = Sin[x],f2(x) = Cos[x] and f3(x) = Exp[x]. data = Table[{x, Sin[x], Cos[x], Exp[x]}, {x, -7, 7, .1}]; (*replace it with Import[file]*) Do[f[i] = Interpolation[data[[All, {1, 1 + i}]]], {i, 3}] Plot[Evaluate[Table[f[i][x], {i, 3}]], {x, -7, 7}] ...


2

For in-place modification use assignment to Part: lis1[[All, All, 2]] = lis2; lis1 {{{83/5, 125.12, AEX}, {996/65, 125.32, AEX}}, {{83/5, 91.34, AFLI}, {996/65, 91.88, AFLI}}} If you do not want to modify lis1 make a copy first and use the same syntax.


1

Now that the other two answers are here, my input is somewhat redundant, but I feel, it's a good exercise in list manipulation and usage of mapping functions, so I'll leave it anyway. Here's a solution, I feel is more readable. First generate some fake data in your format: f[x_, y_] := Sin[x] Exp[y] ylist = Range@4 list = Table[{x, Sequence @@ (f[x, #] ...


1

If the goal is only to obtain the sum of positive roots, then f[r_] := Total[ζ /. NSolve[{Sqrt[r^2 - ζ^2] - ζ Tan[ζ] == 0, r^2 - ζ^2 >= 0, ζ > 0}, ζ]] produces this quantity. For instance, Plot[f[r], {r, .1, 10}, AxesLabel -> {R, Total}] Quiet is used only to suppress the occasional information message, Solve::ratnz: Solve was ...


1

Given: m = {{16, 2, 3, 13}, {{5, 11, 10, 8}, {9, 7, 6, 12}}, {4, 14, 15, 1}}; We could use Sequence to "unwrap" lists of depth 3: Apply[Sequence, m, {-3}] (* {{16, 2, 3, 13}, {5, 11, 10, 8}, {9, 7, 6, 12}, {4, 14, 15, 1}} *) Equivalently: Apply[##&, m, {-3}] Direct replacement of nested lists can work too: Replace[m, {x:_List...} :> x, {1}] ...


1

Late to party, and liking all answers but esp Chris Degnen: per[u_] := Module[{j = 1, lg = Length@u}, While[Total[ Abs[Take[Join @@ ConstantArray[u[[;; j]], Ceiling[lg/j]], lg] - u]] != 0, j++]; {j, u[[;; j]]}] Some test cases: tc={{19, 6, 19, 6, 19, 6, 19, 6, 19, 6, 19, 6}, {73, 7, 4, 73, 7, 4, 73, 7, 4, 73, 7, 4, 73, 7}, {73, 7, 4, 7, ...



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