Bob Hanlon
  • Member for 8 years, 3 months
  • Last seen this week
  • Clarksville, MD
6 answers
24 votes
4k views
Apply multiple functions to same list
Accepted answer
34 votes

Also, y = {1, 2, 3, 4, 5, 6, 7}; #[y] & /@ {Max, Min, Median, Mean} (* {7, 1, 4, 4} *) EDIT: comparing the timings: n = 100000; Do[Through[{Max, Min, Median, Mean}[y]], n] // ...

View answer
6 answers
24 votes
14k views
Drawing a square root spiral
Accepted answer
23 votes

With labels k = 1; angles = NestList[# - ArcTan[1./Sqrt[k++]] &, Pi, 15]; pts = Table[Sqrt[n]* {Cos[angles[[n]]], Sin[angles[[n]]]}, {n, 15}]; Graphics[{ Line[pts], Line[{{0, 0}, #}] ...

View answer
4 answers
24 votes
1k views
Pseudo-currying in one line
Accepted answer
19 votes

EDIT: Modified to cover situation when an argument is a List Use Fold expr = c[a1, a2, a3, a4, a5]; Fold[#1[#2] &, {c, List @@ expr} // Flatten[#, 1]&] (* c[a1][a2][a3][a4][a5] *) expr2 ...

View answer
4 answers
9 votes
4k views
Region bounded by x^2+y^2=1, y=z, x=0, z=0, in first octant
Accepted answer
19 votes

A simple alternative is to use Plot3D with both RegionFunction and Filling. Plot3D[y, {x, 0, 1}, {y, 0, 1}, RegionFunction -> Function[{x, y, z}, x^2 + y^2 <= 1 && x >= 0 &&...

View answer
4 answers
20 votes
774 views
Skipping "middle" Optional Arguments
17 votes

Define function with Null inputs Clear[f] f[a_String: "a", Null, c_String: "c"] := a <> "b" <> c; f[Null, b_String: "b", c_String: "c"] := "a" <> b <> c; f[Null, Null, ...

View answer
7 answers
15 votes
1k views
How to assign a list of numbers into letter grades
17 votes

Clear[grade] grade[x_?NumericQ] = Piecewise[{ {"F", x < 50}, {"D", x < 56}, {"C", x < 71}, {"B", x < 85}}, "A"]; collection = {76.6256, 51.9264, 50.238, 14.4203, 80.9205, ...

View answer
9 answers
11 votes
4k views
Subtract value from list
16 votes

You could also use Threshold list = {2, 3, 5, 4, 6, 7, 3, 7, 5, 4}; value = 5; For the case of integers Threshold[list, value - 1] (* {0, 0, 5, 0, 6, 7, 0, 7, 5, 0} *) EDIT: Comparative timings ...

View answer
2 answers
12 votes
1k views
New fonts in Mathematica 10.4
Accepted answer
16 votes

Fonts in version 10.3.1 v1031 = {"Al Bayan", "Al Nile", "Al Tarikh", "American Typewriter", "Andale Mono", "Apple Braille", "Apple Chancery", "Apple Color Emoji", "AppleGothic", "AppleMyungjo"...

View answer
2 answers
18 votes
839 views
Insets around a clock
15 votes

Clear["Global`*"] AllData = Import["https://pastebin.com/raw/DsVfiMZN", "Table"]; datai = Table[ data[20*i] = AllData[[All, 2*i + 1 ;; 2*i + 2]], {i, 0, 17}]; ploti = Table[ p[20*i] = ...

View answer
3 answers
9 votes
1k views
How can I solve for the intersection points of two ellipses?
15 votes

Solve can be used directly pts = {x, y} /. Solve[{y^2 == 4 - 4 x^2, (1 - (x/2))^2 + (y - 1)^2 == 1}, {x, y}, Reals] // FullSimplify (* {{Root[144 - 160*#1 - 328*#1^2 + 120*#1^3 +...

View answer
5 answers
13 votes
962 views
In a list of points, how to efficiently delete points which are close to other points?
15 votes

pts = Partition[RandomReal[1, 10000], 2]; ListPlot[pts] Use SameTest option with Union pts2 = Union[pts, SameTest -> (Norm[#1 - #2] < 0.05 &)]; Length[pts2] 326 ListPlot[pts2]

View answer
3 answers
0 votes
2k views
How can I plot a polygon with n sides inscribed in a circle and show the area?
15 votes

Off[Solve::ztest]; var = {R, r, a, p, s}; assume = Join[ Thread[var > 0], {R > r, Element[n, Integers], n > 2}]; eqns = { R == s*Csc[Pi/n]/2, r == s*Cot[Pi/n]/2, a == n*s^2*Cot[...

View answer
1 answers
9 votes
802 views
How to enter a nuclear reaction?
Accepted answer
14 votes

Perhaps this is close to what you want: id = IsotopeData[#, "FullSymbol"] &; id["Nitrogen14"] + id["Helium4"] -> id["Oxygen17"] + id["Hydrogen1&...

View answer
1 answers
8 votes
415 views
Mathematica is unable to compute the derivative of the function $\frac{\sin^2(x)}x$
Accepted answer
14 votes

See the possible issues section of the documentation for Piecewise. The proper method for defining f is Clear["Global`*"] f[x_] := Piecewise[{{Sin[x]^2/x, x < 0 || x > 0}}] f[0] (* 0 *) f'[...

View answer
2 answers
12 votes
795 views
How to restore function attributes to default
14 votes

Save defaults before any changes attrLog = Log // Attributes; ClearAttributes[Log, Listable] Log // Attributes {NumericFunction, Protected} Restore defaults Attributes[Log] = attrLog {...

View answer
1 answers
5 votes
253 views
Pass arguments to the list of functions?
Accepted answer
13 votes

f[x_, y_] = x + y; g[x_, y_] = x^3 + y^2 + 2 x; functions = {f, g}; Using Map #[x, y] & /@ functions (* {x + y, 2 x + x^3 + y^2} *) Using Through Through[functions[x, y]] *) (* {x + y, 2 x + ...

View answer
2 answers
4 votes
424 views
Drawing a sequence of circles
Accepted answer
13 votes

Graphics[ {r = Length[Divisors@#]/2; ColorData["Rainbow"][(r - 1)/7], Circle[{#, 0}, r]} & /@ Range[150], ImageSize -> 504]

View answer
3 answers
11 votes
637 views
What's the most efficient way to draw this region?
Accepted answer
13 votes

f1h = HoldForm[10 - Sqrt[10^2 - x^2]]; f1 = f1h // ReleaseHold; f2h = HoldForm[5 - Sqrt[5^2 - (x - 5)^2]]; f2 = f2h // ReleaseHold; f3h = HoldForm[5 + Sqrt[5^2 - (x - 5)^2]]; f3 = f3h // ReleaseHold; ...

View answer
1 answers
9 votes
298 views
Reduce and FullSimplify are being lazy
Accepted answer
13 votes

Use Assuming and the Backsubstitution option for Reduce $Version (* "11.3.0 for Mac OS X x86 (64-bit) (March 7, 2018)" *) constraints = r > 0 && R > 0 && 0 < f < 2 π &...

View answer
2 answers
4 votes
905 views
Drawing lines between matching numbers in a two column table
Accepted answer
13 votes

SeedRandom[10]; col1 = RandomInteger[{1, 20}, 10]; col2 = RandomInteger[{1, 20}, 10]; txt = { n = Length[col1]; Text[ToString[#], {1, n--}, {1.5, 0}] & /@ col1, n = Length[col2]; ...

View answer
5 answers
14 votes
341 views
Can ReplacePart be sped up?
13 votes

data = RandomReal[1, {1000, 1000}]; pos = RandomInteger[{1, 1000}, {5*10^5, 2}]; r1 = ReplacePart[data, pos -> 0]; // AbsoluteTiming {3.145831, Null} In your particular example you have many ...

View answer
2 answers
5 votes
355 views
How to find the sum with Mathematica?
12 votes

Use RootReduce Sum[Tan[(4*j - 3)*Pi/180], {j, 1, 45}] // RootReduce (* 45 *)

View answer
1 answers
7 votes
16k views
Specify legend position in a plot
Accepted answer
12 votes

Legended[ BarChart[{{4, 5, 6}, {1, 2, 3}}, ChartStyle -> {"Pastel", None}], Placed[ SwatchLegend[ ColorData["Pastel", #] & /@ {0, 1}, {"Group A", "Group B"}], {0.8, 0.8}]] EDIT: ...

View answer
3 answers
17 votes
796 views
Select seems unusually slow
12 votes

Solve[{a^2 + b^2 == c^2, a + b + c == 1000, a > 0, b > 0, c > 0, a <= b}, {a, b, c}, Integers] // AbsoluteTiming (* {0.09877, {{a -> 200, b -> 375, c -> 425}}} *)

View answer
2 answers
8 votes
840 views
Probability of an event
Accepted answer
12 votes

Clear[prob] prob[p_, n : _Integer : 1] := RandomChoice[{p, 1 - p} -> {1, 0}, n] Total[prob[0.21321312444, 10^5]]/10.^5. (* 0.21322 *)

View answer
2 answers
7 votes
3k views
How to test whether a function is positive over the entire range of an interval?
Accepted answer
12 votes

To find the intervals for which f[x] is positive f[x_] = -x^3 + x^2 + 7*x; g[x_] = Piecewise[{{f[x], f[x] > 0}}, I]; Plot[{f[x], g[x]}, {x, -3, 4}, PlotStyle -> {Directive[Red, Dashed], Blue}...

View answer
5 answers
14 votes
638 views
Infinite product for Zeta[2]?
12 votes

Amplifying on answer by @rhermans f[m_] = Product[(1296 n^4 (1 + (1 + n)^3))/((-1 + 36 n^2)^2 (-1 + (1 + n)^3)), {n, 1, m}] (* (Pi^2*Gamma[1 + m]^3*Gamma[3 + m])/ (6*(3 + 3*m + m^2)*...

View answer
2 answers
25 votes
1k views
Given an exact formula, how can Mathematica find a probability distribution whose PDF matches it?
12 votes

f[m_] = 1/(2*E^((-m + Log[5])^2/8)*Sqrt[2*Pi]); Integrate[f[m], {m, -Infinity, Infinity}] 1 dist = ProbabilityDistribution[f[m], {m, -Infinity, Infinity}]; Since the integral of f[m] is unity, f[...

View answer
3 answers
7 votes
460 views
Trouble with differential equation
12 votes

DSolve can handle this. Clear[y]; y[x_, e_] = y[x] /. DSolve[{ e y''[x] + y'[x] x == -e Pi^2 Cos[Pi x] - Pi x Sin[Pi x], y[-1] == -2, y[1] == 0}, y[x], x][[1]] // Simplify Manipulate[ ...

View answer
3 answers
7 votes
1k views
Calculating average distance between maxima
12 votes

Generating test data data = Table[{x, Sin[x] + Sin[3. x/2]}, {x, 0, 6. Pi, Pi/5.}]; Clear[f] The interpolation function for the data is f = Interpolation[data]; Maxima occur for f'[x] == 0 and f''...

View answer
1
2 3 4 5
98