Tag Info

Hot answers tagged

7

A bit blunt but I believe it works, it is flexible, and it should be pretty fast: averages[m_?MatrixQ] := With[{ker = 1 - BoxMatrix[0, 3]}, Divide @@ (ListCorrelate[ker, #, {2, -2}, 0] & /@ {m, ConstantArray[1, Dimensions@m]}) ] ker is the kernel of the convolution (or correlation), in this case: 1 - BoxMatrix[0, 3] {{1, 1, 1}, {1, 0, 1}, ...


7

Probably not fast, but very simple: upperTriangular[elements_, n_] := SparseArray[ Thread[ SymmetrizedIndependentComponents[{n, n}, Antisymmetric[{1, 2}]] -> elements]]


4

Here is a semi-imperative function to create an upper-triangular array: upperTriangular[v_] := upperTriangular[v, (1 + Sqrt[1 + 8*Length@v])/2] upperTriangular[v_, n_] := Module[{i = 0}, Array[If[# >= #2, 0, v[[++i]]]&, {n, n}]] The function is expressed using two definitions for a reason that will become clear in a moment. Here it is in action: ...


4

s = 4; lis = Range[s (s - 1)/2]; PadLeft[lis[[1 + # s - (# (1 + #))/2 ;; (1 + #) s - ((# + 1) (2 + #))/ 2]], s, 0] & /@ Range[0, s - 1] // MatrixForm


4

Well that's a hairy one. I like it though, as it forced me to think about aspects of evaluation that I am normally oblivious to. Unfortunately that thinking didn't lead to any great insights. My only idea so far is to interrupt evaluation and mess with the Stack as Leonid did for How do you set attributes on SubValues? I have little experience in this ...


4

How about the old Gayley-Villegas trick? Obj /: (lhs_ = Obj[id_]) := Block[{$inSet = True}, lhs /: (lhs["Property"] = value_) := setObjProperty[id, value]; lhs /: Unset[lhs] := ClearAll[lhs]; lhs = Obj[id] ] /; ! TrueQ[$inSet] Then we get the following behaviour: obj = Obj[1]; UpValues[obj] {HoldPattern[obj["Property"] = value$_] ...


4

Proposal I recommend something like this: IRobot2[IStyle_String, ρ_, VaribleRange_List] := Block[{x, y, z}, With[{expr = Switch[IStyle, "xx", (y^2 + z^2), "yy", (x^2 + z^2), "zz", (x^2 + y^2), "xy", x y, "xz", x z, "yz", y z ]}, Integrate[ρ expr, ##] & @@ Join[{{z}, {y}, {x}}, ...


4

This answer is slightly shorter but still not very elegant. Let m(i,j), i,j, = 1 ... n be your matrix and let us first define the number nc[] (not elegant) of cells to added in each case nc[i_, j_, n_] := 3 /; (i == 1 && j == 1) || (i == 1 && j == n) || (i == n && j == 1) || (i == n && j == n) nc[i_, j_, n_] := 5 ...


4

Update 2: For arbitrary matrices, one can use a relabeling function like numbering (from this answer by Yu-Sung) to produce a matrix with no duplicate elements, and proceed as in the original post: dataB = Partition[RandomChoice[CharacterRange["a", "z"], 20], 4]; numbering[x_] := Block[{n = 0}, Replace[x, y_ :> ++n, {-1}]]; dataB2 = ...


4

Is this what you are after? Manipulate[ Graphics[{Point[#]}, ImageSize -> 1000, AspectRatio -> Automatic, Frame -> True, GridLinesStyle -> Thin, GridLines -> Composition[ Map[ If[#[[2]] - #[[1]] < 10^δ, ## &[], Mean[#]] &, #, {2}] &, Partition[#, 2, 1] & /@ # &, ...


3

Long, long ago, but right here and not in a galaxy far, far away, there was an operating system called MS-DOS that used the character 0x1A as an end-of-file flag. Windows inherited this in its early days. I would have thought that it was eliminated by now, but perhaps not. Mathematica is old enough that it has a system constant $IgnoreEOF. It should be True ...


3

Copy and paste from Code Review: Here are a few methods for your consideration and feedback. All use: s = 5 elems = Range[s(s-1)/2] This one uses the core of my "Dynamic Partition" function. It is the fastest method I know for this problem. Also, perhaps refactoring the code like this makes it more intelligible. dynP[l_, p_] := MapThread[l[[# ;; ...


3

This idea comes from @Dr. Wolfgang Hintze Solving the coefficient of mean meanCoefficient[i_, j_, m_, n_] := 8 /; (1 < i < m && 1 < j < n) meanCoefficient[i_, j_, m_, n_] := 3 /; (i == 1 && j == 1) || (i == 1 && j == n) || (i == m && j == 1) || (i == m && j == n); meanCoefficient[i_, j_, m_, n_] ...


3

When using advanced functionality to deal with primes it is highly recommended not using any of NestList or FoldList or whatever similar. PrimePi is especially designed to find how many primes are below of a given number, then Prime roughly inverse of PrimePi is Listable, therefore I'd suggest this approach yielding the result almost immediately: Total @ ...


2

I like to use Sum for such things, when possible, as it conserves memory and is usually reasonably fast: Sum[Prime @ i, {i, PrimePi[2*^6]}] 142913828922 Performance (still in v7, for now...) compared to Artes's fully vectorized code, with a larger search space: Sum[Prime @ i, {i, PrimePi[2*^7]}] // Timing MaxMemoryUsed[] {1.857, 12272577818052} ...


2

I think that there has been interesting discussion here, but perhaps an appropriate reaction to the original poster is to change the question, and then answer it. The new question: What language should I learn next so as to make me a better Mathematica programmer? In my view there are several possibilities, but the one that strikes me as (likely) the best, ...


2

This is an extended version of the brief suggestion that I gave in my comment above. Solve for the tangent points. Solve[{#.# &[{x1, y1} - {0, 0}] == 3^2, #.# &[{x2, y2} - {12, 0}] == 2^2, (y2 - y1)/(x2 - x1) == -((x1 - 0)/(y1 - 0)) == -((x2 - 12)/(y2 - 0))}, {x1, y1, x2, y2}] (* This gives 4 solutions *) Define the extrusion vector. ...


2

This behavior is present in both version 7 and version 10 (Windows). Illustrated: IdentityMatrix[2] // matrixform {{1, 0}, {0, 1}} // matrixform There is a difference between {{1, 0}, {0, 1}} and (the evaluated form of) IdentityMatrix[2]: the latter is a packed array. {{1, 0}, {0, 1}} // Developer`PackedArrayQ IdentityMatrix[2] // ...


2

I can't explain this strange behaviour of GridBox. But replacing it with Grid I get the desired output (also with a.a // matrixform) matrixform[mat_] := TraditionalForm[ DisplayForm[ RowBox[{StyleBox["[", SpanMaxSize -> \[Infinity]], Grid[mat], StyleBox["]", SpanMaxSize -> \[Infinity]]}]]]; To align the numbers properly use Grid[mat, ...


2

simple version With a single codeline, ColorData["Atoms", "Panel"], can be transformed in a click panel for ElementData[]. {ColorData["Atoms", "Panel"] // ReplaceAll[#, RuleDelayed[ "MouseClicked", $_] :> (RuleDelayed["MouseClicked", atomClicked = Part[RuleDelayed["MouseClicked", $], 2, 2, 2, 1, 1, 1]])] &, Dynamic[atomClicked, Initialization :> ...


1

Here's a procedural, hence compilable solution: Matrixify = Compile[{{lis, _Integer, 1}}, Module[{n, mat, pl = 1, pm = 2, i = 1}, n = Round[(Sqrt[8 Length[lis] + 1] + 1)/2]; mat = Table[0, {n^2}]; Do[ mat[[pm ;; pm + k - 1]] = lis[[pl ;; pl + k - 1]]; i++; pl += k; pm += k + i, {k, n - 1, 1, -1} ]; ...


1

FactorInteger[2434500][[All, 1]] (* {2, 3, 5, 541} *) [[All, 1]] should be read as take all rows, first column


1

I think GridLineData should be optimized by adding a condition as below: Classify the data that has been sorted by using this condition that the numerical difference is small (i.e., two data is very close to) (classification interval is set to δ), In each class of data, the minimum number of as a representative of the group(the last group must take ...


1

It seems to me that for the basic case described in the question it would be best to simply check if a System function considers it valid, as I did for Pattern that matches colors. Therefore: variableQ = Quiet @ ListQ @ Solve[{}, #] &;



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