# Tag Info

18

Just for comparing with Pillsy's answer, let's suppose we generate a uniformly random sequence of a-z and spacebar. SeedRandom[42]; n = 10^7; chars = Union[{" "}, CharacterRange["a", "z"]]; p = DictionaryLookup /@ StringSplit@ StringJoin@ RandomChoice[chars, n]; (Length@p - Count[p, {}])/ Length@p // N (* 0.0071783 *) 2558out of 356352 are "dictionary ...

13

Let's assume we're generating letters with the same frequency as they appear in the dictionary, in strings with lengths that have the same frequency as the lengths of words in the dictionary. To do this, first we need a list of words: In[1]:= words = DictionaryLookup[]; In[2]:= letters = (Values@# -> Keys@#) &@CharacterCounts[StringJoin[words]]; ...

12

the probability of a sequence of a given length being a word (as reported by DictionaryLookup): p[n_] := p[n] = (ToLowerCase /@ DictionaryLookup[StringExpression @@ ConstantArray[_, n]] // Union // Length)/26^n // N (* 27^n if spaces are to be included *) Show[{ ListLogPlot[Table[{n, p[n]}, {n, 3, 20}]], LogPlot[ 71625 ...

11

RandomPartition[n_, p_] := Module[{r}, r = RandomSample[Range[n - 1], p - 1] // Sort; AppendTo[r, n]; Prepend[r // Differences, r[[1]]] ] RandomPartition[100, 16] (* {4, 1, 4, 3, 12, 5, 13, 3, 9, 8, 2, 2, 12, 11, 1, 10} *) RandomPartition[100, 16] // Total (* 100 *) Testing: And @@ Table[ n = RandomInteger[100000]; p = RandomInteger[{1, ...

8

Let's think about when the answer to this question may be relevant. You know that if using the same seed on two different occasions, the RNG will generate the same sequence of numbers. So the relevant questions are: Does Mathematica use the same seed after startup every time? No. This is easy to test. Many programs take the seed from the system time. ...

8

Of course the answer depends greatly on how you "randomly" choose the letters. Here is a Manipulate that reads in a source text, which is used to define the probability of occurrence of any given letter. It writes a short "poem" based on those probabilities. You can also look at probability "pairs" (how often a is followed by b, how often a is followed by c, ...

7

f[m_, n_] := Module[{rg, ok, rs}, rg = Range[m + n]; ok = rg[[2 ;; -2]]; While[True, rs = Sort@RandomSample[ok, n]; If[FreeQ[Differences@rs, 1 | 2], Break[]]]; Fold[ReplacePart[#1, #2 + 1 -> #2] &, rg, rs]] f[10, 2] {1, 2, 2, 4, 5, 6, 7, 8, 9, 10, 10, 12}

7

StringReplacePart[ # , RandomChoice[Characters@#] , {#, #} &@RandomInteger[{1, StringLength@#}] ] &@"ORANGE"

7

The problem consists of two questions: how to determine if circle is inside the ellipse and how to maximize the number of circles? 1. Circle is inside the ellipse? Let us show that the region of possible circle centers are bounded by a parallel curve of degree 8. ClearAll[x, y, a, b, r]; eq1 = Simplify[RegionDistance[Disk[{0, 0}, {a, b}], {x, y}]^2 == ...

6

Solving this exactly is a hard or at least nontrivial problem if you want to prove the exact optimal number. Two things that are easier and still interesting in practice often are: Getting an upper bound for the number of circles in an ellipse From Circle Packing we know that $$\eta=\frac{\pi}{2\sqrt{3}}$$ is the highest possible density that can be ...

6

This will change the first occurrence of a random char by another random char f[s_] := StringReplace[s, Rule @@ RandomChoice[Characters@s, 2], 1] f@"ORANGE" (* "ORRNGE"*)

4

Experience shows that in order to understand a text it is by far not necessary that all ist letters to be correct. Here's a little game to experiment with it. We start with this text from Wikipedia: t = "Mathematica is a symbolic mathematical computation program, \ sometimes called a computer algebra program, used in many scientific, \ engineering, ...

4

Here's a slightly more involved approach that always changes a letter, or signals an error: ClearAll[MutateString]; MutateString::nomut = "All characters in string  are the same."; MutateString[s_String] := With[{choices = DeleteDuplicates[Characters[s]]}, With[{n = RandomInteger[{1, StringLength[s]}]}, StringReplacePart[s, ...

4

This would work: ExtendedList[range_, duplicates_] := MapAt[# - 1 &, Range[range], List /@ Accumulate[Most[RandomChoice[ Flatten[Permutations /@ IntegerPartitions[range - 2 duplicates, {duplicates + 1}], 1] ]] + 2] ] The above code is not efficient for large lists. The code below would be more efficient: ExtendedList[range_, ...

4

This answer replaces an earlier one that deleted only some of the intersecting cylinders. (My thanks to paw for pointing this out.) It also is much faster. The square of the distance between points at p1 and p2 is p1.p1 + p2.p2 - 2 p1.p2 and a cylinder axis can be parameterized by pi + dp t, where pi is one end of the axis, dp is the vector from pi to ...

4

To answer the second part of your question, use the efficient code from @DanielLichtblau, findPoints2, to generate some disks. SeedRandom[111]; pts = findPoints2[50, 0, 1, 0.03, 2.2*0.03] Intersections of the square and disks are given by RegionIntersection with two different heads: DiskSegment for disks along an edge of the square, and RegionIntersection ...

4

Since you are discarding all circles strictly in the interior, substantial time is spent generating them so that they do not intersect other circles and later determining that they are strictly interior to the boundary. Better is to only generate circles that intersect the boundary. This can be done by generating an x value between low and high, a y value ...

4

GraphicsMeshMeshInit[]; BlockRandom[SeedRandom[143, Method -> "MersenneTwister"]; dom = {10, 20}; n = 20; lines = {RandomReal[dom, {2, 2}]}; k = 1; While[k < n, test = RandomReal[dom, {2, 2}]; If[FindIntersections[{Line[lines], Line[test]}] === {}, k++; ...

3

Analytic approach: Manipulate[ SeedRandom["five"]; ListPointPlot3D[ RandomVariate[ TransformedDistribution[{a, b, c*a + (1 - c)*b}, {{a, b} \[Distributed] OrderDistribution[BinormalDistribution[r], {1, 2}]}], 10^3], PlotLabel -> Row[{"c = ", c, " | ", "r = ", r}]], {{c, 0.5}, 0, 1}, {{r, 0}, -.99, .99}]

3

Since v10.2 RandomPoint has provided a way to pick uniform samples from geometric regions (which you can trivially derive from your specification using ImplicitRegion): Eta[a_] := {Cos[a], Sin[a]}; NI[a_] := {Cos[a], Sin[a]}; reg = ImplicitRegion[ And @@ Table[ Dot[{x, y}, Eta[b]] <= Norm[NI[Pi] - Eta[b]]^2 + 2, {b, 0, 2 Pi, 2 Pi/10}], {x, ...

2

An alternative count based on image processing. g2d2 = Graphics[{Disk[#, r] & /@ pts, Circle[{1/2, 1/2}, {2/5, 1/2}]}, PlotRange -> All, Frame -> False] img = g2d2 // Rasterize; c = MorphologicalComponents[ColorNegate@img]; sel = SelectComponents[ c, {"AdjacentBorderCount", "Area"}, #1 == 0 && 50 < #2 < 1000 ...

2

As per my comment, this approach works: TA={{1-I*β/(ωeg-δ),-I*β/(ωeg-δ)},{I*β/(ωeg-δ),1+I*β/(ωeg-δ)}}; Do[L = Sort[RandomReal[10, 10]]; TF = {{Exp[4 π # I δ], 0}, {0, Exp[-4 π # I δ]}} & /@ ({First@L}~Join~Differences@L); m = Block[{TA}, Dot @@ Riffle[TF, TA, {2, 20, 2}]]; T[i] = With[{β = 0.16, ωeg = 1}, Evaluate@(Abs[m[[2, 2]]]^-2)];, {i, 1, ...

2

The required modification is not too hard to do: SeedRandom[159]; pts = Select[findPoints[npts, low, high, minD], EuclideanDistance[#, {1, 1} (low + high)/2] < (low + high)/2 - r &]; g2d = Graphics[{FaceForm @ Lighter[Blue, 0.8], EdgeForm @ Directive[Thickness[0.004], Black], Disk[#, r] & /@ pts, ...

2

From documentation: You can use SeedRandom[n] to make sure you get the same sequence of pseudorandom numbers on different occasions. Reference SeedRandom

2

Here is a very simple way to determine if a generic circle intersects with a line-segment. Probably you can integrate with your code. Let's say the line-segment is defined by the points {x1,y1} and {x2,y2}. This gives the equation of line-segment in parametric form as x=(1 - t) x1 + t*x2 and y=(1 - t) y1 + t*y2 where t \in [0,1] The circle be defined by the ...

2

randomStringReverse[s_String] := StringReplacePart[s, StringReverse @ StringTake[s, #], #]& @ Sort @ RandomInteger[{1, StringLength @ s}, 2] str = "FDSRTYNHFNKHLIUHG"; newStr = randomStringReverse[str] (* "FDSRTYNHILHKNFUHG" *) And to check: MapAt[ Reverse, Transpose @ DeleteCases[Characters /@ {str, newStr} // Transpose, {a_, a_}], 1 ...

2

RandomChoice is not the correct function for your problem. It models the situation where you return a marble to the bag after you remove it and before you make the next choice. For the situation where a marble is not returned to the bag after it is removed, use RandomSample. marbles = {1, 1, 1, 1, 1, 1, 1, 0, 0, 0}; Module[{ngood = 0, ntot = 1000000}, ...

1

I'm not sure what distribution is desired. Here is one that chooses uniformly among all distinction permutations of partitions of all integers m <= n into nonnegative parts no greater than k. This is done by transposing the Young tableaux for partitions of 2n into at most k + 1 parts, and subtracting 1 to get the parts to be between 0 and k. We then ...

1

A simple solution that excludes self-replacement. Function[{s}, StringReplacePart[s, StringTake[s, ConstantArray[#[[1]], 2]], ConstantArray[#[[2]], 2]] &@ RandomSample[Range@StringLength@s, 2]]@"ORANGE" (note you could end up with the same string in the case of repeated characters in the input)

1

The condition that n[t] cannot fall below zero is an inherent part of a solution algorithm that is applied for a numerical SDE solution and preserves a positivity of solution domain. Typically, such problem is solved by using of implicit numerical solution. Currently, Mathematica has a support only for explicit methods for ItoProcess command (the brief ...

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