lattice definition: help

Christofer Edling

unread,

Feb 25, 1998, 3:00:00 AM2/25/98

to

I would be most grateful if someone could help me with this one. I've
tried to solve the problem with the "Table" function without much
success.

I wish to generate an n*n lattice with the following characteristics:

1. Each cell in the lattice can be in one out of three possible states,
i.e. A,B,C.
2. The distribution of states across the whole lattice is defined by
user input, i.e. 30% A's, 20% B's, 50% C's. 3. Given the defined
distribution, each cell in the lattice should be randomly assigned a
state (A,B or C).

Any suggestions appreciated,
Christofer
(ced...@sociology.su.se)

richard j. gaylord

unread,

Mar 2, 1998, 3:00:00 AM3/2/98

to

In article <6d0ch7$2...@smc.vnet.net>, Christofer Edling
<ced...@sociology.su.se> wrote:

here's a way to do it. i've given the answer for 4 states instead in of
3 becuase i just took the code from my new simulation book [coming out
in june]

============================

1 = state A
2 = state B
3 = state C
4 = state D

{s, t, u, v} - probability of being in state A, B, C, D

In[6]:=
s = 0.30; t = 0.20; u = 0.50; v = 0;

In[7]:=
n = 100;

lat = Table[1, {n}, {n}] /. 1 :> Floor[1 + v + u + Random[]] /. {1 :>
Floor[1 + t/(s + t) + Random[]], 2 :> Floor[3 + v/(v + u) + Random[]]};

N[Count[Flatten[lat], 1]/n^2]

Out[10]=
0.3056

N[Count[Flatten[lat], 2]/n^2]

Out[11]=
0.2081

N[Count[Flatten[lat], 3]/n^2]

Out[12]=
0.4863

--
richard j. gaylord, university of illinois, gay...@uiuc.edu

"What I cannot create, I do not understand"
-Richard P. Feynman-

Hugh Walker

unread,

Mar 2, 1998, 3:00:00 AM3/2/98

to

Christofer Edling <ced...@sociology.su.se> asks:

>
I wish to generate an n*n lattice with the following characteristics:

1. Each cell in the lattice can be in one out of three possible states,
i.e. A,B,C.
2. The distribution of states across the whole lattice is defined by
user input, i.e. 30% A's, 20% B's, 50% C's. 3. Given the defined
distribution, each cell in the lattice should be randomly assigned a
state (A,B or C).
>

Exploit the fact that the built-in function Random[] profuces a random
real number z, 0 < z < 1. This function gives one solution to the
problem posed.

randArray[n_][{a_,b_,c_}]:= Module[{z},
Table[z=Random[];
If[z<0.3,a,If[z>0.8,b,c] ],{n},{n}] ]

Cheers!

Hugh Walker
Gnarly Oaks

Allan Hayes

unread,

Mar 2, 1998, 3:00:00 AM3/2/98

to

Christofer Edling wrote:

> I wish to generate an n*n lattice with the following characteristics:
>
> 1. Each cell in the lattice can be in one out of three possible states,
> i.e. A,B,C.
> 2. The distribution of states across the whole lattice is defined by
> user input, i.e. 30% A's, 20% B's, 50% C's. 3. Given the defined
> distribution, each cell in the lattice should be randomly assigned a
> state (A,B or C).

Christopher:

lattice[{a_,b_,c_},n_]:=
With[{ca=a/100//N,cb =(a+b)/100//N},
Table[
Switch[ Random[],
_?(# < ca &), A,
_?(# < cb &), B,
_, C
],
{n},{n}
]
]

Of course, C is redundant information that could be left out. --
Allan Hayes
Training and Consulting
Leicester, UK
h...@haystack.demon.co.uk
http://www.haystack.demon.co.uk
voice: +44 (0)116 271 4198
fax: +44 (0)116 271 8642

Rolf Mertig

unread,

Mar 3, 1998, 3:00:00 AM3/3/98

to

One possibility is:

Options[Lattice] = {States -> {A, B, C}}; (* The first and second
argument are the percentage of the first state, given as reals; n is
the size of the lattice *) Lattice[ia_Real, ib_Real, n_Integer,
opts___Rule] :=
Module[{nn = n^2, a, b, c, stats},
Needs["DiscreteMath`Combinatorica`"];
stats = States /. {opts} /. Options[Lattice]; {a, b} =
Round[{ia*nn, ib*nn}];
c = nn - a - b; Partition[Join[Table[stats[[1]], {a}],
Table[stats[[2]], {b}],

Table[stats[[3]],{c}]][[ToExpression["RandomPermutation"][nn]]],n]

]/;(ia+ib<=1.);
(* This is not necesary, but makes nice colored circles in a Notebook
... *)
MakeBoxes[A, _] :=
InterpretationBox[StyleBox["\[FilledCircle]",
FontColor-> RGBColor[1, 0, 0]], A]; MakeBoxes[B, _] :=
InterpretationBox[StyleBox["\[FilledCircle]",
FontColor-> RGBColor[0, 1, 0]], B]; MakeBoxes[C, _] :=
InterpretationBox[StyleBox["\[FilledCircle]",
FontColor-> RGBColor[0, 0, 1]], C]; (* This is your example:
30% A's, 20% B's, and take n = 22 *) Lattice[0.3, 0.2, 22]

Rolf Mertig
http://www.mertig.com

Christofer Edling wrote:

> I would be most grateful if someone could help me with this one. I've
> tried to solve the problem with the "Table" function without much
> success.
>

> I wish to generate an n*n lattice with the following characteristics:
>
> 1. Each cell in the lattice can be in one out of three possible states,
> i.e. A,B,C.
> 2. The distribution of states across the whole lattice is defined by
> user input, i.e. 30% A's, 20% B's, 50% C's. 3. Given the defined
> distribution, each cell in the lattice should be randomly assigned a
> state (A,B or C).
>

calv...@calvitti.ces.cwru.edu

unread,

Mar 3, 1998, 3:00:00 AM3/3/98

to

C> I wish to generate an n*n lattice with the following
C> characteristics:
C> 1. Each cell in the lattice can be in one out of three possible
C> states, i.e. A,B,C. 2. The distribution of states across the
C> whole lattice is defined by user input, i.e. 30% A's, 20% B's,
C> 50% C's. 3. Given the defined distribution, each cell in the
C> lattice should be randomly assigned a state (A,B or C).

Random[] generates uniformly distributed r.v. in the range [0,1], so you
can map that segment into your desired values like this:

In[3]:= f[x_] := A /; 0 <= x < 0.2

In[4]:= f[x_] := B /; 0.2 <= x < 0.5

In[5]:= f[x_] := C /; 0.5 <= x < 1

then you can map f[] across the n by n table

In[9]:= tmp = Table[Random[],{i,1,4},{j,1,4}];

In[11]:= Map[f,tmp,{2}] //MatrixForm

Out[11]//MatrixForm= C C C C

A A A C

C C B B

B C B C

Paul Abbott

unread,

Mar 4, 1998, 3:00:00 AM3/4/98

to

Christofer Edling wrote:

> I wish to generate an n*n lattice with the following characteristics:
>
> 1. Each cell in the lattice can be in one out of three possible states,
> i.e. A,B,C.
> 2. The distribution of states across the whole lattice is defined by
> user input, i.e. 30% A's, 20% B's, 50% C's. 3. Given the defined
> distribution, each cell in the lattice should be randomly assigned a
> state (A,B or C).

An answer appeared in the Mathematica Journal 1(3): 57. For symbols

In[1]:= symbols = {a, b, c};

with relative frequencies

In[2]:= freqs = {0.3, 0.2, 0.5};

we count for how many symbols the cumulative frequencies:

In[3]:= cumfreq[l_List] := FoldList[Plus, First[l], Rest[l]]/Plus @@ l;

In[4]:= cf = cumfreq[freqs]
Out[4]= {0.3, 0.5, 1.}

are less than a fixed random number t in the range [0,1], and use the
number of hits as the index into the alphabet:

In[5]:= index[f_, r_] := Length[Select[f, r >= #1 & ]] + 1; In[6]:=
rand[l_List, f_List] := l[[index[f, Random[]]]]

In[7]:= Table[rand[symbols, cf], {4}, {4}] Out[7]= {{c, a, c, c}, {c, a,
c, c}, {a, a, b, c}, {c, c, c, c}}

In 2 Dimensions suppose the "alphabet"

In[8]:= s = {a, b, c, d}; t = {1, 2, 3, 4};

has the joint frequency table

In[9]:= f = {{0, 0, 0, 3}, {1.2, 0, 2, 0}, {1, 1, 0, 0}, {1, 0, 0.9,
1}};

The cumulative frequencies by row are

In[10]:= frow = cumfreq[Plus @@ Transpose[f]] Out[10]= {0.27027,
0.558559, 0.738739, 1.}

whilst the set of cumulative frequencies by column are

In[11]:= fcol = cumfreq /@ f

Out[11]=
1 {{0, 0, 0, 1}, {0.375, 0.375,
1., 1.}, {-, 1, 1, 1},
2
{0.344828, 0.344828, 0.655172, 1.}}

We can use the pair of cumulative frequencies to produce a random sample
following the joint frequency table as follows. We use one uniformly
distributed random number to fix the row index and, using this index
into the cumulative frequencies by column, a second random number to
fix the column index:

In[12]:= sampmat = Table[{s[[i = index[frow, Random[]]]],
t[[index[fcol[[i]], Random[]]]]}, {5}]

Out[12]= {{d, 4}, {d, 4}, {d, 4}, {a, 4}, {d, 4}}

Cheers,
Paul

____________________________________________________________________
Paul Abbott Phone: +61-8-9380-2734
Department of Physics Fax: +61-8-9380-1014
The University of Western Australia Nedlands WA 6907
mailto:pa...@physics.uwa.edu.au AUSTRALIA
http://www.pd.uwa.edu.au/~paul

God IS a weakly left-handed dice player
____________________________________________________________________

Christofer Edling

unread,

Mar 12, 1998, 3:00:00 AM3/12/98

to

Many thanks to all of you who answered my call for help. I very much
appreciate your willingness to share your knowledge with such
generosity. I learned several new Mathematica things from your
suggestions (yes Rolf, the colored circles are very nice!).
//Christofer