# Tag Info

35

The only reason I am attempting to answer this is to perhaps get a Reversal badge. There you go... We will go slowly and this answer is the basis for what comes next. Let's start with two dimensions. You'll see why. We create a rectangular region: Needs["NDSolveFEM"] mesh = ToElementMesh[FullRegion[2], {{0, 5}, {0, 1}}, "MeshOrder" -> 1, ...

20

BernoulliDistribution is a perfect fit for this. RandomVariate[BernoulliDistribution[1 - 0.1], {50}] {1, 1, 1, 0, 1, 1, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 1, 1, 1, 1} Also, as kguler states, you can use RandomChoice, but the benefit of BernoulliDistribution is that ...

13

The printed version of the 2002 edition was printed 3 times and sold out 3 times; Springer and Google recently started selling it (book only) as a PDF eBook (no software) on the Springer and Google sites for $79. I know other authors (e.g. here) have gone to some trouble to make their books available here on stack exchange ... We are delighted to be able ... 13 The separation-of-variables solution you quoted has two indices appearing in it: n and j (the subscripts of the coefficient$A_{nj}$). Here, n is azimuthal mode order, i.e. it counts the number of nodes along the direction in which the polar-angle$\theta$varies (divided by 2). The index j is needed because the wave is supposed to satisfy the boundary ... 13 Usage Just use this function with any polyhedron in in form: GraphicsComplex[pts_, Polygon[vertices_, ___]]. When I find time and motivation maybe I will add more DownValues so it can be more general. Atm you can play with solids given by PolyhedronData[... "Faces"]: polyhedronRandomWalk[ PolyhedronData["DuerersSolid", "Faces"] ] It ... 10 ClearAll[dist] dist [rho_] := CopulaDistribution[{"Binormal", rho}, {UniformDistribution[{0, 1}], UniformDistribution[{0, 1}]}]; data1 = RandomVariate[dist[-.9], 5000]; ListPlot[data1, Frame -> True, AspectRatio -> 1] data2 = RandomVariate[dist[.6], 5000]; ListPlot[data2, Frame -> True, AspectRatio -> 1] 8 A couple things: You don't update velocity (obx and oby appear to be unused?). You do your timestep wrong (you want x+=velocity*timestep, not x=velocity*time!). You also have your direction of your force wrong. You should take the negative gradient of potential. The gradient of 1/r is -1/r^2. The negative of that is 1/r^2. So you get the common sense result ... 7 With eqn[{k_, r_, H0_, P0_}] := {H'[t] == r (1 - H[t]/k) - d H[t] P[t], P'[t] == -s P[t] + e H[t] P[t], H[0] == H0, P[0] == P0} d = 0.01; s = 0.3; e = 0.02; I would define one simulation as sim := Module[ {k = RandomVariate[NormalDistribution[150, 20]], r = RandomVariate[NormalDistribution[0.4, 0.003]], H0 = RandomVariate[UniformDistribution[{50, ... 5 For loop is always slow. You may try this: f = Compile[{{x, _Real}, {y, _Real}}, If[y >= 12. Cos[x] && y >= 10 + x^3, 1, 0]]; vol[n_Integer /; n <= 10^6] := 3.* Total[f@@@Transpose@{RandomReal[{0, 1}, n], RandomReal[{10, 13}, n]}]/n; The calculation of 1000000 samples takes 1.1 s on my i5-3210M. 5 With f[a_, {x_, y_}] := Piecewise[{{a x, x < y}, {x, x == y}, {1 - a + a x, x > y}}, 0] one simulation can be defined by sim[length_] := Module[{rv = RandomVariate[BetaDistribution[3, 1], length], y, yBar}, y[1] = First@rv; yBar[t_Integer] := yBar[t] = 1/t * Sum[y[i], {i, 1, t}]; y[t_Integer] := y[t] = f[0.5, {rv[[t]], yBar[t - 1]}]; ... 5 Take a uniform random distribution and check if it is above some threshold (0.9 in your case). For example: dist[] := If[RandomReal[] > 0.9, 0, 1]; Table[dist[], {i, 100}] 4 I do not know why, but the following are much faster than Walk: ClearAll[walkF,walkF2]; walkF[x_List, a_List, b_List, sigma_] := With[{f = TruncatedDistribution[Transpose[{a - x, b - x}], ProductDistribution @@ ConstantArray[NormalDistribution[0, sigma], Length[x]]]}, x + RandomVariate[f]] walkF2[x_List, a_List, b_List, sigma_] := ... 4 It looks like I'm late to the party but here is my approach. Common functions and data: trinarize[a_List, γ_?NumericQ] := UnitStep[a - γ] + UnitStep[γ + a] labels = {0 -> "bottom", 1 -> "middle", 2 -> "top"}; SeedRandom[1] sampleSimulation = RandomChoice[{-1, 0, 1}, 20] {0, -1, 0, 0, -1, -1, -1, 0, -1, -1, -1, -1, 1, -1, 0, 1, -1, -1, 0, 0} ... 4 I think your core idea about post-processing the splittings is a good one. It can be expressed somewhat more elegantly (although elegance is a subjective matter) with the help of linked lists rather than Reap/Sow: ClearAll[ll]; SetAttributes[ll,HoldAllComplete]; toLinkedList[l_List]:= Fold[ll[#2,#1]&,ll[],Reverse[l]] and ClearAll[process]; ... 4 RandomChoice[{.9, .1} -> {1, 0}, 10] (* {0, 1, 1, 1, 1, 1, 1, 0, 1, 1} *) Timing results Timing[RandomVariate[BernoulliDistribution[.9], {10^8}];] (* {3.38014, Null} *) Timing[RandomChoice[{.9, .1} -> {1, 0}, 10^8];](* {5.64937, Null} *) dist[] := If[RandomReal[] > 0.9, 0, 1]; Timing[Table[dist[], {i, 10^8}];] (* {13.9842, Null} *) One nice ... 3 data10 = RandomVariate[f[13, 0.5], {10, 25}]; (* 10 data sets from distribution f *) lls= LogLikelihood[EstimatedDistribution[#, f[a, b], {{a, 1}, {b, 1}}], #] & /@data10 (*{-32.4994, -25.2268, -21.9671, -26.8963, -25.9164, -22.8958, -26.5247, -24.9622, -33.9319, -28.6512}*) maxll=Block[{k=1}, MaximalBy[Last][ With[{dist = ... 3 You can also use RandomVariate with DiscreteUniformDistribution: rW[a_, b_, n_] := Accumulate[Prepend[ RandomVariate[DiscreteUniformDistribution[{{-a, a}, {-b, b}}], n]], {0,0}] dt = rW[10, 20, 100]; Graphics[{PointSize[Large], Red, Point@#, Thick, Blue, Line@#} &@dt, Frame -> True, Axes->True, AspectRatio -> 1/GoldenRatio] We get the ... 3 Edited I don't like this much because what I take are intended to be the osculating circles don't have a radius equal to the radius of curvature. I used your formula, but it appears to be wrong. Nevertheless, what I've worked out does install a popup menu into a Manipulate expression which will select which parametric function will be displayed. It will ... 3 I don't understand your original code very well (particularly the definitions of listadj1 and listadj2), but here's my naive translation for your description, I only rewrote the simulation part: densitytest = With[{dis2 = idx^2, limit = adjLimit}, Compile[{{pos, _Real, 2}}, Times @@ UnitStep@(limit + 1 - Max /@ Transpose[Total /@ ... 3 Looks like a glitch, however you can invert the CDF to get the desired result (not as fast, of course): InverseCDF[HyperbolicDistribution[1, 59.428, 18.441, 3.428*^-9, -0.00065], RandomReal[1, 10]] (* {0.000448962, 0.0144836, 0.0481936, -0.0169342, 0.0445246, -0.0151702, 0.00316436, 0.00877931, 0.085059, 0.00880039} *) 3 I would build your simulation with a DynamicModule showing a table made with a Grid and controlled by a Trigger. First I would define a function that calculates distance when given time and acceleration. dist[a_, t_] := a t^2/2 Next I would get the basic functionality right. A grid showing time and distance with a trigger to control it. With[{a = -9.8, ... 2 Using sim[length_] := Module[{rv = RandomVariate[BetaDistribution[2, 1], length], y, yMed}, y[1] = First@rv; yMed[t_Integer] := yMed[t] = Median[y /@ Range[t]]; y[t_Integer] := y[t] = f[0.5, {rv[[t]], yMed[t - 1]}]; yMed /@ Range[length] ] results in plots like Here Median[y /@ Range[t]] calculates the median for y[1] to y[t], as stated ... 2 SeedRandom[1]; sampleSimulation = RandomChoice[{-1, 0, 1}, 20] rplcR = {(0) -> "middle", {beg___, mid : Alternatives @@ PatternSequence @@@ {{"top", "bottom"}, {"bottom", "top"}}, end___} :> {beg, Sequence @@ Riffle[{mid}, "jump"], end}}; jtsrcF = Composition[Join @@ # &, Tally /@ # &, Split, # //. rplcR &, ... 2 I think using linked lists is usually the best way to proceed in cases like this. Start with coords = {}; Each time you generate a new point, r, add it with coords = {coords, r}; This is very fast, but will generate a deeply nested list. When all the points have been generated, flatten and re-partition the list, which is also very fast. coords = ... 2 Define a list large enough to hold your coordinates: coor = Table[Null, {100}]; Then, starting with i = 1; Let some program fill in the values coor[[i++]] = {0., 0., 0.}; coor[[i++]] = {0.1, 0.1, 0.003}; Finally, delete the remaining Null-values: DeleteCases[coor, Null] {{0., 0., 0.}, {0.1, 0.1, 0.003}} This should be significantly faster 2 f[r_?NumberQ,n_Integer]:={First[#],#.{r,Sqrt[1-r^2]}}&/@RandomReal[NormalDistribution[0,1],{n,2}]; Produces n pairs of numbers with the correlation r. 1 a = 3; b = 5; randomWalk = NestList[# + {RandomInteger[{-a, a}], RandomInteger[{-b, b}]} &, {0, 0}, 100] (* {{0, 0}, {2, 2}, {1, -3}, {-2, 2}, {1, 4}, {1, 3}, {1, 2}, {4, 0}, {4, 0}, {3, -4}, {4, -1}, {2, -5}, {0, 0}, {0, 0}, {2, -3}, {3, -6}, {2, -11}, {4, -10}, {4, -5}, {7, -3}, {9, \ -3}, {6, -8}, {9, -12}, {7, -16}, {5, -11}, {6, -16}, {4, ... 1 Brute Force: While[! ( .9 < Correlation[ a = RandomReal[{0, 1}, 10], b = RandomReal[{0, 1}, 10 ]] < .91 ) ] Correlation[ a, b] 0.900731 {a, b} // MatrixForm I expect this breaks down in a hurry for larger sets. 1 Based on the comments appended to the question, I believe that what you are looking for is: mvBeta[myrating, #, myR] & /@ RandomReal[{0,1},100] where you can change 100 to be any length vector you like, and myrating and myR have already been defined. 1 Using ManToGif by Vitaliy Kaurov ManToGif[man_, name_String, step_Integer] := Export[name <> ".gif", Import[Export[name <> Which[$OperatingSystem == "MacOSX", ".mov", \$OperatingSystem == "Windows", ".avi"], man], "ImageList"][[1 ;; -1 ;; step]]]; Now write SetDirectory[NotebookDirectory[]]; r = 1; backgroundAxes ...

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