Tag Info

New answers tagged

2

Here's the brute force way: og = CirculantGraph[100, Range[2]]; g = RandomGraph[WattsStrogatzGraphDistribution[100, 0.05]]; oelist = Sort /@ EdgeList[og]; elist = Sort /@ EdgeList[g]; rewired = Complement[oelist, elist] {4 <-> 6, 19 <-> 20, 21 <-> 23, 26 <-> 27, 31 <-> 32, 33 <-> 35, 44 <-> 45, 55 <-> 56, 56 <-> 58, ...


2

As with Mr.W, not totally clear on the question, but I think this does what you want: pluckReinsert[list_, num_] := Module[{picked, left}, Fold[Insert[#, #2, RandomInteger[{1, Length@# + 1}]] &, Sequence @@ With[{picked = RandomSample[list, num]}, {left = DeleteCases[list, _?(MemberQ[picked, #] &)], picked}]]] An alternative ...


2

I'm not certain I understand the question so I'll post my code and you can tell me if this does what you expect: pluck[cards_, n_] := {cards[[#]], Delete[cards, List /@ #]} & @ RandomSample[Range @ Length @ cards, n] place[{set_, cards_}] := Fold[Insert[#, #2, 1 + RandomInteger @ Length @ #] &, cards, set] Example: Array[C, 10] ~pluck~ 3 // ...


5

Maybe longer than 1 or 2 lines but it is readable. Of course you could shorten it, but I tend to mess up the code when I try to make it too short. :-) newStack[list_, k_] := Module[{smallerStack, drawnCards, randomChoice, length}, length = Length[list]; randomChoice = RandomSample[Range[length], k]; drawnCards = list[[randomChoice]] ...


1

If you want to sequentially pluck and reinsert one card at a time so that there are always $N$ possible choices for the pluck operation and $N$ choices for the insert operation you can do the following: list = {card1, card2, card3, card4, card5, card6, card7, card8}; pluckReinsert[list_, k_] := pluckReinsert[pluckReinsert[list, 1], k - 1]; ...


6

listA=CharacterRange["a","j"]; k = 5; set = RandomSample[Range@Length@listA, k] listA[[ set]] = listA[[ RandomSample@set]]; listA {8, 3, 10, 1, 4} {"g", "b", "c", "d", "j", "f", "e", "h", "i", "a"}


1

I did not assume you won't have repeated elements in your base list (that is after all one way to weight sampling). rsamp[list_, needs_, size_] := RandomSample[Join[needs, RandomSample[Fold[DeleteCases[#1, #2, 1, 1] &, list, needs], Max[0, size - Length@needs]]], size]; This works correctly for weighted base lists: data = {"a", "w", "l", "a", ...


0

Not an answer, mentioning in case anyone knows how to proceed. One might start from uniformly drawn random numbers and see what's their distribution after the constraints are imposed : dist = TransformedDistribution[{b, c, d} \[Conditioned] (1 < d < b < c && b + d < c && b + 2 d > c), ...


2

Not completely sure I'm understanding. Anyway, for Directed Graphs without self loops: randomDegreeGraph[m_List] := Module[{n, t, t1, obj, s, x}, n = Length@m; t = Table[If[i != j, x[i, j], Sequence @@ {}], {i, n}, {j, n}]; t1 = Table[If[i != j, x[i, j], 0], {i, n}, {j, n}]; obj = Transpose[{List /@ m, t}]; t1 /. ...


2

You can use igraph through my RLink-based package IGraphR. mat = Import["https://dl.dropboxusercontent.com/u/62056077/TestMatrix.m", "Package"]; mat == Transpose[mat] (* ==> False *) Your adjacency matrix is not symmetric. Are you looking for directed or undirected graphs? degs = Total[mat]; This degree sequence happens to be graphical, so let's ...


5

How about f[x_, y_] = h - 3.07; Then, drawing candidates dat = {RandomVariate[UniformDistribution[{-2, 2}], np], RandomVariate[UniformDistribution[{-2, 2}], np]} // Transpose; and selecting Show[Select[dat, f @@ # > 0 &] // ListPlot[#, AspectRatio -> 1] &, S] the corresponding data can be exported as Export["test.dat",dat] ...


5

E.g, function squares list elements: l1 = {1, 2, 3, 4, 5} {l1, l2, l3, l4, l5, l6} = NestList[#^2 &, l1, 5] (* {{1, 2, 3, 4, 5}, {1, 4, 9, 16, 25}, {1, 16, 81, 256, 625}, {1, 256, 6561, 65536, 390625}, {1, 65536, 43046721, 4294967296, 152587890625}, {1, 4294967296, 1853020188851841, 18446744073709551616, 23283064365386962890625}} *) This ...


2

This comes with several caveats: (1) It is also often slow. I have reason to believe it gets careless about certain "painted into a corner" situations, and thus might simply fail. (2) It gives results that are in no sense uniformly random, across the range of possible graphs that meet the requirements. (3) I wrote it some time ago and no longer understand ...


1

As Kuba said, FoldList is what I need: FoldList[g[#1, 3] + #2 &, .5, delta]


1

Redundant way : Fold[MapAt[2 # &, #1, #2] &, p1, j]


2

p1 = {1, 2, 3, 4, 5, 6, 7, 8}; j = {1, 6, 7, 8}; p1[[j]] *= 2; p1 (* {2, 2, 3, 4, 5, 12, 14, 16} *) Replacing your function (I assume you want to keep the argument/original unchanged and return the changed version): p1 = {1, 2, 3, 4, 5, 6, 7, 8}; domul[p1_] := Module[{replacement = p1, j = {1, 6, 7, 8}}, replacement[[j]] *= 2; replacement]; ...


5

Just do the following: p1[[j]] = 2 p1[[j]] Then p1 gives: {2, 2, 3, 4, 5, 12, 14, 16}


1

Newlist = ReplacePart[#2, Rule @@@ Transpose[{#3, #1[[#3]]}]] &[list1, list2, {1, 5}]


5

Another way, doing it all at once: Newlist = list2; Newlist[[{1,5}]] = list1[[{1,5}]]; Gives Newlist (* {1, b, c, d, 5} *)


2

list1 = {1, 2, 3, 4, 5}; list2 = {a, b, c, d, e}; NewList = list2; NewList[[1]] = list1[[1]]; NewList[[5]] = list1[[5]]; NewList {1, b, c, d, 5}


2

I think you want to define f1 as f1 = Function[u, 3 + u] since the form you started with would have created the function and then applied it to x. The easiest way to do what you want is to use Map: Map[f1, list] which has an equivalent syntax f1 /@ list If you really must use a Do loop, you would do it as follows: Module[{result = {}}, ...


1

Memory inefficient approach: RandomSample[ DeleteCases[Tuples[Range[5], {2}], {n_, n_}], 5] or alternatively with Subsets. RandomSample[Join[{##}, Reverse /@ {##}] & @@ Subsets[Range[5], {2}], 5] Time inefficient approach: list = {}; Do[ While[ While[Equal @@ ({i, j} = RandomInteger[5, 2])]; MemberQ[list, {i, ...


0

EDIT (after Kuba comment) You can use RandomSample ,e.g If the aim is sampling from {1,2,3,4,5}^2: RandomSample[Tuples[Range[5], 2]] yielding {{4, 2}, {4, 3}, {1, 4}, {5, 3}, {1, 1}, {5, 1}, {2, 1}, {2, 4}, {2, 5}, {5, 2}, {1, 2}, {1, 5}, {3, 3}, {4, 5}, {5, 5}, {3, 4}, {2, 2}, {5, 4}, {3, 5}, {1, 3}, {4, 1}, {3, 2}, {2, 3}, {3, 1}, {4, 4}} ...


8

The key to speedup here is generating the set of random number in one go instead of calling RandomVariate repeatedly. Generally, instead of Table[RandomVariate[...], {size}] use RandomVariate[..., size] It can also generate a multidimensional array of random values in one go. I rewrote your code to do this: out = AbsoluteTiming[Table[ ...


0

Here is another answer which fails because it is too slow. The generation of the deviates takes about 10 seconds on my laptop. In C I can generate the same number of multinomial deviates in about 0.013 seconds. The code below does have the correct complexity which is why I am posting it. I am posting this here so that I can link to it from another question ...


2

RandomChoice can take a list of weights, so you can do this: Join[RandomChoice[xelement -> elements, 24], PosFCC, 2]


0

elements = Transpose[{{Fe, Mn, Cu, Ni, Tc}}]; xelement = {0.3, 0.3, 0.15, 0.1, 0.15}; Introduce this: names = {Fe, Mn, Cu, Ni, Tc}; Evaluating names xelement then gives {0.3 Fe, 0.3 Mn, 0.15 Cu, 0.1 Ni, 0.15 Tc} and RandomSample[names xelement] gives {0.3 Mn, 0.15 Cu, 0.15 Tc, 0.1 Ni, 0.3 Fe} The last part of your question I cannot ...


5

There is actually a fair bit going on here that can make this confusing. The critical thing is the difference between testing fit to a family of distributions compared to testing fit to a particular distribution. Let me demonstrate. SeedRandom[23]; data = RandomVariate[NormalDistribution[1, 2], 100]; DistributionFitTest[data, NormalDistribution[mu, ...


4

If you wanted to automate things you might do something like this: tests = Sort[(g = DistributionFitTest[ w, #, {"PValue", "FittedDistribution"}]) & /@ { GammaDistribution[a, b, c, d], NormalDistribution[a, b], ChiSquareDistribution[a], HalfNormalDistribution[a], ...


12

The mathematica help is very thorough and is very indicative of what you should do next. By way of the histogram diagram obtained, you can compare your data against the proposed distribution. Show[Histogram[w[[2, 1]], Automatic, "ProbabilityDensity"], Plot[PDF[h["FittedDistribution"], x], {x, 0, 1500}, PlotStyle -> Thick]] The reference points you ...


8

Ad 1 When the walker is corssing the boundary region: pos = Most@Accumulate[Length /@ SplitBy[tc/2 - Max /@ Abs@random, Sign]]; With[{cube = First[PolyhedronData["Cube"]]}, Graphics3D[{{Opacity[0.1], Scale[cube, tc]}, Line[random], PointSize@.03, Red, Point[random[[pos]]]}, Axes -> True]] Ad 2 When the walker reaches the boundary ...


3

There are several ways to do this. The structure of your 1d output is not optimal, because you get something like {{x1},{x2},...} which means a nested list. To make it short, if you want to use ListLinePlot, you can do it with the help of Epilog, which draws your first and last points on the final graphics: oneDim = RandomWalk[500, 1]; ...


4

Ok, here it is 1D, not sure if I understood the question right, but see if this what you want randomWalk[n_, d_] := Table[{RandomReal[{-1, 1}], 0}, {n}]; data = randomWalk[50, 1]; ListPlot[data, PlotStyle -> PointSize[.01], PlotRange -> {Automatic, {-.1, .1}}, Epilog -> {PointSize[.02], Red, Point[data[[1]]], Blue, Point[data[[-1]]]}]


11

Here is an approach. rws[n_, p0_?(Norm@# == 1 &), ang_] := NestList[RotationMatrix[ ang/(2 Pi), (Function[{u, v}, {Cos[u] Cos[v], Cos[u] Sin[v], Sin[u]}] @@ RandomReal[{0, 2 Pi}, 2])].# &, p0, n] Visualizing: Graphics3D[{Sphere[], Line[rws[10000, {1, 0, 0}, 1]]}, Boxed -> False]


8

If something is evaluating forever it is because of poor implementation, an error or because it is just too much work to do :). What I'm doing while debugging, is: if it looks ok -> run the minimal example, if it fails -> run it step by step As you can see Abs[0. - 0.0987745-] is an expression that has now way to appear if - is real Minus. ...


0

I am confused at what is the aim but I post in the aim of facilitation. If the aim is sampling from a fixed multinomial distribution with fixed probability vector and counting the number of 'empty boxes' in sample: Count[#, 0] & /@ RandomVariate[MultinomialDistribution[10, {1/2, 1/4, 1/4}], 100] is example 10 boxes, with probabilities {1/2, 1/4, ...


1

It took two days and required me to think which is, of course, disgusting, but I found a solution. The original pseudo-code loop (see above) was a loop over things that I think of as "boxes" (not mentioned in the original pseudo-code). The number of boxes has typically been 8,000 but I can envision problems for which it might be some millions. What I needed ...



Top 50 recent answers are included