Hi!!!
While I'm waiting for solving my problems with displaying the hypercube
:), I remembered a little simulation from Scientific American, and
wanted to try it in lisp. The idea is as follows:
You have a 2-dimensional world; its like the surface of a torus (you
know...when you try to leave from one side, you appear in the
opposite). In each "place" of the world there is a person, who has one
of two states: 1 or 0. In the begining, those are randomly distributed.
But then, one at a time, each person changes its states "influenced" by
his/her neighbour: you have to choose one of his/her 8 neighbours, and
you set the "central" person state with the state of that particular
neighbour. I hope I made myself clear.
In the end, it is expected that all the persons share the same state.
Well, here is my code, waiting for critics, etc (remember: I want to
learn!!!! :-))
(defun situacion-inicial (ancho alto)
(let ((situacion (make-array (list ancho alto) :initial-element 0)))
(dotimes (i ancho)
(dotimes (j alto)
(setf (aref situacion i j) (random 2))))
situacion))
(defun comprobar (n maximo)
(when (< n 0) (setf n (- maximo 1)))
(when (> n maximo) (setf n 0))
n)
(defun cambiar-opinion (situacion ancho alto)
(let ((i (random ancho))
(j (random alto))
(d (random 8))
(in 0)
(jn 0))
(cond
((= 0 d) (decf in) (decf jn))
((= 1 d) (decf in) )
((= 2 d) (decf in) (incf jn))
((= 3 d) (decf jn))
((= 4 d) (incf jn))
((= 5 d) (incf in) (decf jn))
((= 6 d) (incf in) )
((= 7 d) (incf in) (incf jn)))
(setf in (comprobar in ancho))
(setf jn (comprobar jn alto))
(setf (aref situacion i j) (aref situacion in jn))
situacion))
(defun recuento-opinion (situacion ancho alto)
(let ((n 0))
(dotimes (i ancho)
(dotimes (j alto)
(when (= 0 (aref situacion i j))
(incf n))))
n))
(defun correr (&optional (veces 1000) (ancho 10) (alto 10))
(let ((situacion (situacion-inicial ancho alto)))
(dotimes (i veces)
(print situacion)
(let ((n (recuento-opinion situacion ancho alto)))
(when (or (zerop n) (= n (* ancho alto)))
(format t "Congrats! You reach uniformity in ~d steps" i)
(setf i veces))
(setf situacion (cambiar-opinion situacion ancho alto))))))
Of course, I don't like the "cond" block; it's too *big*!!! But didn't
figure out how to make it smaller.
I didn't use any global variable! (Thanks, Pascal!!!!)
What I like more is the "ascii graphics" :-)
Thanks,
Luis.
From: Peter Seibel
Subject: Re: Simulation: Changes of opinion (a little less newbie...)
Date:
Message-ID: <m2pss4rvxi.fsf@gigamonkeys.com>
[Apologies if this comes through more than once--Gnus freaked out on me.]
"LuisGLopez" <············@gmail.com> writes:
> Hi!!!
>
> While I'm waiting for solving my problems with displaying the hypercube
> :), I remembered a little simulation from Scientific American, and
> wanted to try it in lisp. The idea is as follows:
>
> You have a 2-dimensional world; its like the surface of a torus (you
> know...when you try to leave from one side, you appear in the
> opposite). In each "place" of the world there is a person, who has one
> of two states: 1 or 0. In the begining, those are randomly distributed.
> But then, one at a time, each person changes its states "influenced" by
> his/her neighbour: you have to choose one of his/her 8 neighbours, and
> you set the "central" person state with the state of that particular
> neighbour. I hope I made myself clear.
>
> In the end, it is expected that all the persons share the same state.
>
> Well, here is my code, waiting for critics, etc (remember: I want to
> learn!!!! :-))
>
> (defun situacion-inicial (ancho alto)
> (let ((situacion (make-array (list ancho alto) :initial-element 0)))
> (dotimes (i ancho)
> (dotimes (j alto)
> (setf (aref situacion i j) (random 2))))
> situacion))
>
> (defun comprobar (n maximo)
> (when (< n 0) (setf n (- maximo 1)))
> (when (> n maximo) (setf n 0))
> n)
Note that you don't have to set N and then return it. You can write
this:
(defun comprobar (n maximo)
(cond
((< n 0) (- maximo 1))
((> n maximo) 0)
(t n)))
Though this look a lot like what MOD does (except that that (> n
maximo) would have to be (>= n maximo). I suspect you can replace the
calls to (comprobar n whatever) with (mod n whatever)
> (defun cambiar-opinion (situacion ancho alto)
> (let ((i (random ancho))
> (j (random alto))
> (d (random 8))
> (in 0)
> (jn 0))
> (cond
> ((= 0 d) (decf in) (decf jn))
> ((= 1 d) (decf in) )
> ((= 2 d) (decf in) (incf jn))
> ((= 3 d) (decf jn))
> ((= 4 d) (incf jn))
> ((= 5 d) (incf in) (decf jn))
> ((= 6 d) (incf in) )
> ((= 7 d) (incf in) (incf jn)))
> (setf in (comprobar in ancho))
> (setf jn (comprobar jn alto))
> (setf (aref situacion i j) (aref situacion in jn))
> situacion))
Aren't in and jn supposed to have some relationship to i and j? As it
stands now they'll always end up having the value 0, 1, or one less
than either ancho or alto. (They start at 0 and get either incremented
or decremented by one and then possibly get "wrapped around" with
COMPROBAR.
> Of course, I don't like the "cond" block; it's too *big*!!! But didn't
> figure out how to make it smaller.
Here are a couple ways. First off you can use CASE instead of COND:
(case d
(0 (decf in) (decf jn))
(1 (decf in) )
(2 (decf in) (incf jn))
(3 (decf jn))
(4 (incf jn))
(5 (incf in) (decf jn))
(6 (incf in) )
(7 (incf in) (incf jn)))
Then we could note that you're really just trying to set in and jn to
-1, 0, or 1 and express that i bit more directly:
(destructuring-bind (in jn)
(case d
(0 '(-1 -1))
(1 '(-1 0))
(2 '(-1 1))
(3 '(0 -1))
(4 '(0 1))
(5 '(1 -1))
(6 '(1 0 ))
(7 '(1 1)))
...)
Then we can note that a CASE with a bunch of consecutive integer cases
starting at 0 is a lot like indexing into a vector and make this data
driven:
(defparameter *offsets* #((-1 -1) (-1 0) (-1 1) (0 -1) (0 1) (1 -1) (1 0) (1 1)))
(destructuring-bind (in jn) (aref *offsets* d)
...)
But I suspect what you really want is something like this (untested):
(defun random-step () (1- (random 3)))
(defun cambiar-opinion (situacion)
(let* ((ancho (array-dimension situacion 0))
(alto (array-dimension situacion 1))
(i (random ancho))
(j (random alto))
(in (mod (+ i (random-step)) ancho))
(jn (mod (+ j (random-step)) alto)))
(setf (aref situacion i j) (aref situacion in jn)))
situacion)
-Peter
--
Peter Seibel * ·····@gigamonkeys.com
Gigamonkeys Consulting * http://www.gigamonkeys.com/
Practical Common Lisp * http://www.gigamonkeys.com/book/
From: Nathan Baum
Subject: Re: Simulation: Changes of opinion (a little less newbie...)
Date:
Message-ID: <degfk0$7v9$1@news8.svr.pol.co.uk>
LuisGLopez wrote:
> Hi!!!
>
> While I'm waiting for solving my problems with displaying the hypercube
> :), I remembered a little simulation from Scientific American, and
> wanted to try it in lisp. The idea is as follows:
>
> You have a 2-dimensional world; its like the surface of a torus (you
> know...when you try to leave from one side, you appear in the
> opposite). In each "place" of the world there is a person, who has one
> of two states: 1 or 0. In the begining, those are randomly distributed.
> But then, one at a time, each person changes its states "influenced" by
> his/her neighbour: you have to choose one of his/her 8 neighbours, and
> you set the "central" person state with the state of that particular
> neighbour. I hope I made myself clear.
>
> In the end, it is expected that all the persons share the same state.
>
> Well, here is my code, waiting for critics, etc (remember: I want to
> learn!!!! :-))
>
> (defun situacion-inicial (ancho alto)
> (let ((situacion (make-array (list ancho alto) :initial-element 0)))
> (dotimes (i ancho)
> (dotimes (j alto)
> (setf (aref situacion i j) (random 2))))
> situacion))
>
> (defun comprobar (n maximo)
> (when (< n 0) (setf n (- maximo 1)))
> (when (> n maximo) (setf n 0))
> n)
That is (mod n maximo). :)
>
> (defun cambiar-opinion (situacion ancho alto)
> (let ((i (random ancho))
> (j (random alto))
> (d (random 8))
> (in 0)
> (jn 0))
> (cond
> ((= 0 d) (decf in) (decf jn))
> ((= 1 d) (decf in) )
> ((= 2 d) (decf in) (incf jn))
> ((= 3 d) (decf jn))
> ((= 4 d) (incf jn))
> ((= 5 d) (incf in) (decf jn))
> ((= 6 d) (incf in) )
> ((= 7 d) (incf in) (incf jn)))
> (setf in (comprobar in ancho))
> (setf jn (comprobar jn alto))
> (setf (aref situacion i j) (aref situacion in jn))
> situacion))
You've be much better off using a CASE here, or looking up a pair of
offsets in a vector. Also, unless my logic is faulty, you need to be
indexing by (+ in i) and (+ jn j) rather than just in and jn.
>
> (defun recuento-opinion (situacion ancho alto)
> (let ((n 0))
> (dotimes (i ancho)
> (dotimes (j alto)
> (when (= 0 (aref situacion i j))
> (incf n))))
> n))
>
> (defun correr (&optional (veces 1000) (ancho 10) (alto 10))
> (let ((situacion (situacion-inicial ancho alto)))
> (dotimes (i veces)
> (print situacion)
> (let ((n (recuento-opinion situacion ancho alto)))
> (when (or (zerop n) (= n (* ancho alto)))
> (format t "Congrats! You reach uniformity in ~d steps" i)
> (setf i veces))
> (setf situacion (cambiar-opinion situacion ancho alto))))))
>
> Of course, I don't like the "cond" block; it's too *big*!!! But didn't
> figure out how to make it smaller.
>
> I didn't use any global variable! (Thanks, Pascal!!!!)
>
> What I like more is the "ascii graphics" :-)
>
> Thanks,
>
> Luis.
>
My attempt:
(defun make-world (width height)
(let ((grid (make-array (list width height))))
(dotimes (i width)
(dotimes (j height)
(setf (aref grid i j) (random 2))))
grid))
(defun change-opinion (world)
(let* ((w (array-dimension world 0))
(h (array-dimension world 1))
(i (random w))
(j (random h)))
(destructuring-bind (in jn)
(aref '#((-1 -1) (-1 0) (-1 +1)
( 0 -1) ( 0 +1)
(+1 -1) (+1 0) (+1 +1))
(random 8))
(setf (aref world i j)
(aref world (mod (+ i in) w) (mod (+ j jn) h))))))
(defun count-zeroes (world)
(let ((w (array-dimension world 0))
(h (array-dimension world 1))
(n 0))
(dotimes (i w)
(dotimes (j h)
(when (zerop (aref world i j))
(incf n))))
n))
(defun main (&key (max-iters 1000) (width 10) (height 10))
(let ((world (make-world width height)))
(dotimes (i max-iters)
(let ((n (count-zeroes world)))
(when (or (zerop n) (= n (* width height)))
(format t "Congrats! You reach uniformity in ~d steps~%" i)
(return t))
(if (= 0 (mod i 1000))
(format t "~A ~A~%" i n)))
(change-opinion world))))
(main :max-iters 100000 :width 10 :height 10)
(quit)
Thank you, Nathan!!!!
> > (defun comprobar (n maximo)
> > (when (< n 0) (setf n (- maximo 1)))
> > (when (> n maximo) (setf n 0))
> > n)
>
> That is (mod n maximo). :)
Ouch! That's absolutely right! (must confess that it took ~30secs for
me to get it, while looking at my PC screen...)
> Also, unless my logic is faulty, you need to be
> indexing by (+ in i) and (+ jn j) rather than just in and jn.
Ouch number 2!!! :-) Absolutely right.
>
> (defun change-opinion (world)
> (let* ((w (array-dimension world 0))
> (h (array-dimension world 1))
> (i (random w))
> (j (random h)))
> (destructuring-bind (in jn)
> (aref '#((-1 -1) (-1 0) (-1 +1)
> ( 0 -1) ( 0 +1)
> (+1 -1) (+1 0) (+1 +1))
> (random 8))
> (setf (aref world i j)
> (aref world (mod (+ i in) w) (mod (+ j jn) h))))))
Didn't know about the 'array-dimension' function; very useful!
'destructuring-bind' and the rest looks obscure to me; I'll check it in
the books; but it looks great! ;)
> (defun main (&key (max-iters 1000) (width 10) (height 10))
Yeap; &keys look better than &optional...
Thank you very much!!! I really learned a lot from you!!!
Luis.
P.S.: But, please let me tell you that your code misses the pleasent
"graphic art" of the arrays scrolling in screen, showing the incoming
uniformity like a movie... :)
From: Nathan Baum
Subject: Re: Simulation: Changes of opinion (a little less newbie...)
Date:
Message-ID: <degi7d$q5d$1@newsg4.svr.pol.co.uk>
LuisGLopez wrote:
> Thank you, Nathan!!!!
No worries.
> P.S.: But, please let me tell you that your code misses the pleasent
> "graphic art" of the arrays scrolling in screen, showing the incoming
> uniformity like a movie... :)
Well, _I_ thought it looked rubbish. ;-)
If you want a more convincing movie look, see if inserting
(format t "~A[2J" #\Escape)
before you display the image will clear the screen. #\Escape isn't
standard, so I can't guarantee it'll work. Also, if it does work, it
might flicker. I couldn't find any way around that, so I took out the
display entirely.
On 24 Aug 2005 17:23:45 +0100, <····@cawtech.freeserve.co.uk> wrote:
>
> Or you could try an X11 version:
> ....
>
> I don't know whether I have managed to write portable CLX
> code, but black is winning in the window I'm watching it run
> in just now. Oh, actually white is making a come back, but
> is still quite sparse.
Worked fine in CMUCL19b, but black won in moments here. A useful
example for a new CLX hacker, thanks!
--
Program A uses CLOS, Program B is implemented with structs, leading
to a fourfold increase in execution speed. --J. B. Heimatseiten
"LuisGLopez" <············@gmail.com> writes:
> P.S.: But, please let me tell you that your code misses the pleasent
> "graphic art" of the arrays scrolling in screen, showing the incoming
> uniformity like a movie... :)
Actually, if you execute it in emacs, it scrolls which is not the best
effect you can get.
You could use an xterm and insert a clear-screen or goto-home before
displaying the new state.
;; see: http://aspell.net/charsets/iso6429.html
(defconstant +ESC+ #.(code-char 27))
(defconstant +IS2+ #.(code-char 30))
(defun clear-screen (&optional (*standard-output* *standard-output*))
(format t "~Cc" +ESC+))
(defun goto-xy (col row &optional (*standard-output* *standard-output*))
(format t "~C[~D;~DH" +ESC+ row col))
and either run it from xterm, or open an xterm from emacs; for example
in clisp 2.34:
(defun correr (&key (veces 1000) (ancho 10) (alto 10))
(let ((situacion (situacion-inicial ancho alto)))
(format t "~:[Uniformity not reached!~;~
~:*Congrats! You reach uniformity in ~d steps~]"
(block :result
(with-open-stream (*standard-output* (POSIX:MAKE-XTERM-IO-STREAM))
(sleep 1) ; give times to make-xterm-io-stream to garble
; the display with the pty...
(clear-screen)
(dotimes (i veces)
(goto-xy 0 0)
(print situacion)
(finish-output) ; to be sure it shows.
(sleep 0.1)
(let ((n (recuento-opinion situacion)))
(when (or (zerop n) (= n (* ancho alto)))
(return-from :result i)))
(cambiar-opinion situacion)))))))
Note the rebinding of *standard-output* is a quick-and-dirty trick
(unless you have a multithreaded CL implementation). It might be
better to pass the xterm stream explicitely to allow you to process
several windows at the same time.
--
"A TRUE Klingon warrior does not comment his code!"
> LuisGLopez wrote:
>>
>> You have a 2-dimensional world; its like the surface of a torus (you
>> know...when you try to leave from one side, you appear in the
>> opposite). In each "place" of the world there is a person, who has one
>> of two states: 1 or 0. In the begining, those are randomly distributed.
>> But then, one at a time, each person changes its states "influenced" by
>> his/her neighbour: you have to choose one of his/her 8 neighbours, and
>> you set the "central" person state with the state of that particular
>> neighbour. I hope I made myself clear.
>>
>> In the end, it is expected that all the persons share the same state.
Since the choice is random, on a sufficiently large torus, it never
ends. For instance, Alan's (x-version "localhost" 10 60 60)
--
Program A uses CLOS, Program B is implemented with structs, leading
to a fourfold increase in execution speed. --J. B. Heimatseiten
From: Nathan Baum
Subject: Re: Simulation: Changes of opinion (a little less newbie...)
Date:
Message-ID: <dej7el$ocv$1@newsg4.svr.pol.co.uk>
GP lisper wrote:
>>LuisGLopez wrote:
>>
>>>You have a 2-dimensional world; its like the surface of a torus (you
>>>know...when you try to leave from one side, you appear in the
>>>opposite). In each "place" of the world there is a person, who has one
>>>of two states: 1 or 0. In the begining, those are randomly distributed.
>>>But then, one at a time, each person changes its states "influenced" by
>>>his/her neighbour: you have to choose one of his/her 8 neighbours, and
>>>you set the "central" person state with the state of that particular
>>>neighbour. I hope I made myself clear.
>>>
>>>In the end, it is expected that all the persons share the same state.
>
>
> Since the choice is random, on a sufficiently large torus, it never
> ends. For instance, Alan's (x-version "localhost" 10 60 60)
>
>
I disagree.
If 75% of the cells are in state 1, there is necessarily only a 25%
chance that any random cell will be in state 0.
When 50% are in state 1, a random change will either result in >50%
being in state 1 or <50% being in state 1. In the former event, it is
more likely that a change to state 1 will happen in the next iteration;
in the latter event, it is more likely that a change to state 0 will
happen in the next iteration.
The distribution of opinions is like a Brownian walk across a hill,
where the crest of the hill is 50% distribution, and either side is 0%
and 100% respectively. It move partially at random, but has a slight
bias towards 'downward' motion, which attracts it to 0% or 50% respectively.
Because the algorithm randomly selects a _neighbouring_ cell, the
picture is not quite as simple as this. 'Clumping' affects the
probability of change.
When the states are completely random, like white noise, there's a 50%
chance that a cell's neighbour will be in a different state. Over time,
states clump together, and the chance of any random cell's neighbour
being in a different state decreases, even if the overall distribution
of states is still 50/50. There are always interfaces between clumps of
different states, however: whilst there are two states in the grid there
will always be a cell with state 1 adjacent to a cell with state 0, and
so there's always the possibility of an imbalance forming.
Having said that, I've done over a million iterations of a 60x60 grid so
far, and it still hasn't converged. So although the probability of it
_never_ converging is vanishingly small, it's still going to take a long
time.
On Thu, 25 Aug 2005 02:42:16 +0100, <···········@btinternet.com> wrote:
>
>
> GP lisper wrote:
>>>LuisGLopez wrote:
>>>
>>>>You have a 2-dimensional world; its like the surface of a torus (you
>>>>know...when you try to leave from one side, you appear in the
>>>>opposite). In each "place" of the world there is a person, who has one
>>>>of two states: 1 or 0. In the begining, those are randomly distributed.
>>>>But then, one at a time, each person changes its states "influenced" by
>>>>his/her neighbour: you have to choose one of his/her 8 neighbours, and
>>>>you set the "central" person state with the state of that particular
>>>>neighbour. I hope I made myself clear.
>>>>
>>>>In the end, it is expected that all the persons share the same state.
>>
>> Since the choice is random, on a sufficiently large torus, it never
>> ends. For instance, Alan's (x-version "localhost" 10 60 60)
>
> I disagree.
>
> If 75% of the cells are in state 1, there is necessarily only a 25%
> chance that any random cell will be in state 0.
"In the begining, those are randomly distributed."
If that statement is actually true, for every localized distribution
for 'white' that is 75-25, there is an equivalent distribution
elsewhere for 'black'.
The initial distribution will not be 50-50 black-white, but with a
true gaussian coin flipper, that distribution cannot evolve.
With a broken PRNG, it does eventually end, regardless of torus size.
To trace all of this stuff out and fix it is tons of work, usually
people settle for 'good enough'. Most of the need for the work is
beyond the mathematical talents of the programmer, which has lead to
some interesting hacks.
--
Program A uses CLOS, Program B is implemented with structs, leading
to a fourfold increase in execution speed. --J. B. Heimatseiten
From: Nathan Baum
Subject: Re: Simulation: Changes of opinion (a little less newbie...)
Date:
Message-ID: <delh3o$ovd$1@news8.svr.pol.co.uk>
GP lisper wrote:
> On Thu, 25 Aug 2005 02:42:16 +0100, <···········@btinternet.com> wrote:
>
>>
>>GP lisper wrote:
>>
>>>>LuisGLopez wrote:
>>>>
>>>>
>>>>>You have a 2-dimensional world; its like the surface of a torus (you
>>>>>know...when you try to leave from one side, you appear in the
>>>>>opposite). In each "place" of the world there is a person, who has one
>>>>>of two states: 1 or 0. In the begining, those are randomly distributed.
>>>>>But then, one at a time, each person changes its states "influenced" by
>>>>>his/her neighbour: you have to choose one of his/her 8 neighbours, and
>>>>>you set the "central" person state with the state of that particular
>>>>>neighbour. I hope I made myself clear.
>>>>>
>>>>>In the end, it is expected that all the persons share the same state.
>>>
>>>Since the choice is random, on a sufficiently large torus, it never
>>>ends. For instance, Alan's (x-version "localhost" 10 60 60)
>>
>>I disagree.
>>
>>If 75% of the cells are in state 1, there is necessarily only a 25%
>>chance that any random cell will be in state 0.
>
>
> "In the begining, those are randomly distributed."
>
> If that statement is actually true, for every localized distribution
> for 'white' that is 75-25, there is an equivalent distribution
> elsewhere for 'black'.
Not all all.
What you're describing is almost the statement "In the beginning, those
are uniformly distributed".
It's possible, although of course highly unlikely, that the initial
distribution is all 1s. (The odds are 1 in 10^1083. Rather slim, but
still possible.)
> The initial distribution will not be 50-50 black-white, but with a
> true gaussian coin flipper, that distribution cannot evolve.
A genuinely random source of integers won't have a normal (a.k.a.
Guassian) distribution, it'll have a uniform distribution. Even then, a
75:25 distribution [i]can[/i] evolve from a 50:50 distribution even with
a Gaussian source of random integers.
> With a broken PRNG, it does eventually end, regardless of torus size.
> To trace all of this stuff out and fix it is tons of work, usually
> people settle for 'good enough'. Most of the need for the work is
> beyond the mathematical talents of the programmer, which has lead to
> some interesting hacks.
I disagree. I believe it is likely to end regardless of whether or not
the PRNG is broken. I can't prove it, but I believe it is clear that it
is _possible_ for it to end.
I said that with a 75:25 distribution, it was more likely to head
towards a 100:0 distribution than a 0:100 distribution, but having done
the math I've found that isn't true.
Using a 10x10 grid, and copying from any random cell (rather than just
adjacent cells):
Case 1: 50/50
The probability of the distribution becoming 51/49 is
Selecting a 0 50/100
then Selecting a 1 50/99
Total 25/99
The probability of the distribution becoming 49/51 is
Selecting a 1 50/100
then Selecting a 0 50/99
Total 25/99
The probability of the distribution not changing is slightly under 50%.
I know that seems odd: it's the same counter-intuitive effect seen in
Monty Hall.
Case 2: 51/49
The probability of the distribution becoming 52/48 is
Selecting a 0 49/100
then Selecting a 1 51/99
Total 833/33000
The probability of the distribution becoming 50/50 is
Selecting a 1 51/100
then Selecting a 0 49/99
Total 833/33000
The probabilities are equal.
Case 3: 99/1
The probability of the distribution becoming 100/0 is
Selecting a 1 99/100
then Selecting a 0 1/99
Total 1/100
The probability of the distribution becoming 98/2 is
Selecting a 0 1/100
then Selecting a 1 99/99
Total 1/100
We can see that change becomes less likely as the distribution becomes
less even. However, change only becomes impossible when the distribution
is 100/0 or 0/100.
I have a hunch that the probability of the system reaching uniformity
approaches 1 as the number of iterations approaches infinity. But I
don't have the mathematical know-how to test the conjecture.
The actual algorithm is slightly more complex: it only copies adjacent
cells. In the general case, the probability of change is dependant upon
how the states are distributed. I don't care to do the math for that.
There's a special case where it doesn't matter:
Case 4: 99/1
The probability of the distribution becoming 100/0 is
Selecting a 1 which is adjacent to a 0 8/100
then Selecting that 0 1/8
Total 1/100
The probability of the distribution becoming 98/2 is
Selecting the 0 1/100
then Selecting an adjacent 1 8/8
Total 1/100
From: lin8080
Subject: Re: Simulation: Changes of opinion (a little less newbie...)
Date:
Message-ID: <430EB88C.9C386C18@freenet.de>
GP lisper schrieb:
> With a broken PRNG, it does eventually end, regardless of torus size.
> To trace all of this stuff out and fix it is tons of work, usually
> people settle for 'good enough'. Most of the need for the work is
> beyond the mathematical talents of the programmer, which has lead to
> some interesting hacks.
One more hack. I split each field into a 3x3 field. The border values
represent the neighbor values in the actual state, in the middle is the
field value itself.
Now I add a layer under this field also in 3x3 and write in their the
status from the cycle before. This way I have a history where the value
of the field and its neighbors come from. (I use 2 number digits to
represent the content, not only -1,0,1. So, first digit from 1-9 is high
value, second digit is free defun ..)
And now I add a third layer to this (it is now a cube). There some
calculations take place to allow this "one" field to judge its status
against his neighbors and do corrections seperat to each neighbor (also
represent in a 2 digit number). (There I experiment from time to time)
This leads to an update in the first layer, where I have now corrected
values depending on historical trends. With this values I make the new
value of this "one" field (traditional in -1, 0, +1)
This is, I have more possibilities to store data about the status of on
field and do not need very complex algorithm when calculating. Else I
get an individuel relation to each neighbor field.
stefan
From: Nathan Baum
Subject: Re: Simulation: Changes of opinion (a little less newbie...)
Date:
Message-ID: <dej841$bsf$2@newsg1.svr.pol.co.uk>
GP lisper wrote:
>> LuisGLopez wrote:
>>
>>> You have a 2-dimensional world; its like the surface of a torus (you
>>> know...when you try to leave from one side, you appear in the
>>> opposite). In each "place" of the world there is a person, who has one
>>> of two states: 1 or 0. In the begining, those are randomly distributed.
>>> But then, one at a time, each person changes its states "influenced" by
>>> his/her neighbour: you have to choose one of his/her 8 neighbours, and
>>> you set the "central" person state with the state of that particular
>>> neighbour. I hope I made myself clear.
>>>
>>> In the end, it is expected that all the persons share the same state.
>
>
>
> Since the choice is random, on a sufficiently large torus, it never
> ends. For instance, Alan's (x-version "localhost" 10 60 60)
>
>
I disagree.
If 75% of the cells are in state 1, there is necessarily only a 25%
chance that any random cell will be in state 0.
When 50% are in state 1, a random change will either result in >50%
being in state 1 or <50% being in state 1. In the former event, it is
more likely that a change to state 1 will happen in the next iteration;
in the latter event, it is more likely that a change to state 0 will
happen in the next iteration.
The distribution of opinions is like a Brownian walk across a hill,
where the crest of the hill is 50% distribution, and either side is 0%
and 100% respectively. It move partially at random, but has a slight
bias towards 'downward' motion, which attracts it to 0% or 100%
respectively.
Because the algorithm randomly selects a _neighbouring_ cell, the
picture is not quite as simple as this. 'Clumping' affects the
probability of change.
When the states are completely random, like white noise, there's a 50%
chance that a cell's neighbour will be in a different state. Over time,
states clump together, and the chance of any random cell's neighbour
being in a different state decreases, even if the overall distribution
of states is still 50/50. There are always interfaces between clumps of
different states, however: whilst there are two states in the grid there
will always be a cell with state 1 adjacent to a cell with state 0, and
so there's always the possibility of an imbalance forming.
Having said that, I've done over a million iterations of a 60x60 grid so
far, and it still hasn't converged. So although the probability of it
_never_ converging is vanishingly small, it's still going to take a long
time.
Hi!
First of all, please let me thank you all again; your posts are really
making me advance (and think!!!!).
I feel deeply attracted by Alan's solution for finding neighbours; it's
little and shiny like a jewel. But I must confess that I prefer the
'destructuring-bind' approach, for a weird reason: I could understand
it without looking for it in the books!!! (maybe I'm becoming a
little-lisper? I would love to believe it! :) I mean, at first it
looked oscure to me, but then I "saw" how it works. Don't ask... :)
Now, there's something I don't get. Pascal told me that I don't need to
do this:
(setf situacion (cambiar-opinion situacion))
because 'cambiar-opinion' is a procedure, and I can do just this:
(cambiar-opinion situacion)
How is that? How is that 'situacion' "realizes" that its value has
change, and auto-assigns it? I must confess that that is beyond my
understanding... understand me: I come from java :-)
All the comments are, as I said, absolutely stimulating. I even could
see the Alan's x11 version working (extremely fast) in my screen!!!!
If you let me say something else, I didn't find such high level of
ideas, different approachings to the same problem, and clear and
verbose explanations in any other programming language forum... Is it
that lisp made you this way, or is that that kind of people make its
way to lisp? Anyway, I'm very happy to be here! :-)
From: Nathan Baum
Subject: Re: Simulation: Changes of opinion (a little less newbie...)
Date:
Message-ID: <dejf9t$bgm$1@newsg2.svr.pol.co.uk>
LuisGLopez wrote:
> Hi!
>
> First of all, please let me thank you all again; your posts are really
> making me advance (and think!!!!).
>
> I feel deeply attracted by Alan's solution for finding neighbours; it's
> little and shiny like a jewel. But I must confess that I prefer the
> 'destructuring-bind' approach, for a weird reason: I could understand
> it without looking for it in the books!!! (maybe I'm becoming a
> little-lisper? I would love to believe it! :) I mean, at first it
> looked oscure to me, but then I "saw" how it works. Don't ask... :)
I don't think that's a weird reason. In fact, I'd say that's probably
the only good reason you could have for choosing one method over
another. Assuming, of course, that both methods actually work ;).
Alan's solution is certainly concise, but it isn't at all obvious how it
works (to my eyes, at least), nor is it obvious how to extend it deal
with larger neighbourhoods. I think either of the destructuring-bind or
seperately offsetting in and jn are quite clear, and that's why you'd
prefer them.
I think I'd use
(random-elt '((-1 -1) (-1 0) (-1 +1)
( 0 -1) ( 0 +1)
(+1 -1) (+1 0) (+1 +1)))
Where RANDOM-ELT is a utility function you'd define yourself. I think
the layout makes it especially obvious what's happening.
> Now, there's something I don't get. Pascal told me that I don't need to
> do this:
> (setf situacion (cambiar-opinion situacion))
> because 'cambiar-opinion' is a procedure, and I can do just this:
> (cambiar-opinion situacion)
> How is that? How is that 'situacion' "realizes" that its value has
> change, and auto-assigns it? I must confess that that is beyond my
> understanding... understand me: I come from java :-)
It doesn't. You don't really change the value of 'situacion', but
instead the value of one of the elements in the array which 'situacion'
references.
The variable 'situacion' in 'correr' refers to the _same_ array as the
variable 'situacion' in 'cambiar-opinion'.
Suppose 'cambiar-opinion' changes the value of the element at (7 7). If
we draw a graph of how element (7 7) might be referenced, it could look
like this:
correr/situacion -----------\
+---> array ---> element at (7 7)
cambiar-opinion/situacion---/
To reiterate: There's only one array, so any changes you make via one
reference to it _must_ affect the other references.
I hope that makes things clear. :)
> All the comments are, as I said, absolutely stimulating. I even could
> see the Alan's x11 version working (extremely fast) in my screen!!!!
Yes, it worked (almost) just fine for me. The only hickup was that I
needed to change
(require 'clx)
to
(eval-when (:compile-toplevel) (require 'clx))
in order to compile it. (Otherwise, the XLIB package wasn't found.)
> If you let me say something else, I didn't find such high level of
> ideas, different approachings to the same problem, and clear and
> verbose explanations in any other programming language forum... Is it
> that lisp made you this way, or is that that kind of people make its
> way to lisp?
Both, I'm certain. I know Lisp changed the way I think about
programming, but I was drawn to Lisp because I knew that the languages I
was used to were 'wrong' in many ways.
Whilst Lisp has its problems (I won't say what they are, because they
probably aren't the same problems that _you_ think it has), I can solve
nearly all of them using macros. Then, I don't ever have to solve them
again.
> Anyway, I'm very happy to be here! :-)
Nathan Baum wrote:
> Alan's solution is certainly concise, but it isn't at all
> obvious how it works (to my eyes, at least), nor is it
> obvious how to extend it deal with larger
> neighbourhoods. I think either of the destructuring-bind
> or seperately offsetting in and jn are quite clear, and
> that's why you'd prefer them.
>
> I think I'd use
>
> (random-elt '((-1 -1) (-1 0) (-1 +1)
> ( 0 -1) ( 0 +1)
> (+1 -1) (+1 0) (+1 +1)))
That is wonderful. That is the kind of clarity to aim for.
I've tried writing Conway's Life.
(defun life (a i j)
(case (count-neighbours a i j)
((0 1) 0)
(2 (aref a i j))
(3 1)
(t 0)))
I found that
(defun neighbour (n)
(multiple-value-bind (quotient remainder)
(floor (+ n 5) 3)
(list (- (mod quotient 3) 1)
(- remainder 1))))
(defun count-neighbours (a i j)
(loop for r from 0 to 7
sum (apply #'aref a
(mapcar
(lambda (base offset modulus)
(mod (+ base offset) modulus))
(list i j)
(neighbour r)
(array-dimensions a)))))
were too slow, so I just had a nice cup of tea and settled
down to type
(defun count-neighbours (a i j)
(let ((r (array-dimension a 0))
(s (array-dimension a 1)))
(+ (aref a
(mod (+ i 1) r)
(mod (+ j 1) s))
(aref a
(mod (+ i 1) r)
(mod (- j 1) s))
(aref a
(mod (- i 1) r)
(mod (+ j 1) s))
(aref a
(mod (- i 1) r)
(mod (- j 1) s))
(aref a (mod (+ i 1) r) j)
(aref a (mod (- i 1) r) j)
(aref a i (mod (+ j 1) s))
(aref a i (mod (- j 1) s)))))
which made it run many times faster.
It would be nice to have an on-torus macro so that one could
type
(defun count-neighbours-using-macro (world i j)
(on-torus (world i j)
(+ (a + -) (a + 0) (a + +)
(a 0 -) (a 0 +)
(a - -) (a - 0) (a - +))))
and have it generate really fast code. If one wanted the
macro to produce top quality code it would be quite hairy.
For example you wouldn't want the macro to produce
(aref a (mod (+ i 1) r)
(mod (+ j 0) s))
instead of
(aref a (mod (+ i 1) r)
j)
The compiler will probably get (+ j 0) => j
but it has no way of knowing that we are happy with j instead
of (mod j s)
Such a macro would take thirty times as long to
write as just sitting down and typing (mod ...) twelve times.
There wouldn't be any point, unless there was money left in
the training budget and you had to find things to do to use
it up, or you were some kind of hopeless parenthesis
addict...
(defmacro on-torus ((torus row col) &body code)
"Access neighbours with (a + +) or (a 0 -) or ..."
(let ((torus-holder (make-symbol "torus"))
(row-sym (make-symbol "row"))
(col-sym (make-symbol "col"))
(row-dim-sym (make-symbol "rows"))
(col-dim-sym (make-symbol "cols")))
`(let* ((,torus-holder ,torus)
(,row-sym ,row)
(,col-sym ,col)
(,row-dim-sym (array-dimension ,torus-holder 0))
(,col-dim-sym (array-dimension ,torus-holder 1)))
(macrolet
((a (row-code col-code)
(flet
((decode
(code-atom row-or-col)
(ecase code-atom
(0 (case row-or-col
(row ',row-sym)
(col ',col-sym)))
((+ -) (let ((offset (case code-atom
(+ 1)
(- -1))))
(case row-or-col
(row `(mod (+ ,',row-sym ,offset)
,',row-dim-sym))
(col `(mod (+ ,',col-sym ,offset)
,',col-dim-sym))))))))
(list 'aref
',torus-holder
(decode row-code 'row)
(decode col-code 'col)))))
,@code))))
* (on-torus (#2a((bottom-left bottom bottom-right)
(left centre right)
(top-left top top-right))
1 1)
(list (a 0 0)(a + +)(a + -)))
=> (CENTRE TOP-RIGHT TOP-LEFT)
Alan Crowe
Edinburgh
Scotland
Nathan Baum ha escrito:
>
> It doesn't. You don't really change the value of 'situacion', but
> instead the value of one of the elements in the array which 'situacion'
> references.
>
> The variable 'situacion' in 'correr' refers to the _same_ array as the
> variable 'situacion' in 'cambiar-opinion'.
>
> (...)
>
> I hope that makes things clear. :)
Absolutely!!! Once again, thank you very much, Nathan! :-)
Luis.
GP lisper <········@clouddancer.com> wrote:
+---------------
| > LuisGLopez wrote:
| >> In the end, it is expected that all the persons share the same state.
|
| Since the choice is random, on a sufficiently large torus, it never ends.
| For instance, Alan's (x-version "localhost" 10 60 60)
+---------------
Well, I compiled it, which made it go *much* faster[1], and even so
your "10 60 60" case did indeed run for a long time, but eventually
[in only the time it took me to read the rest of the thread] the
whole window turned black. So there. ;-}
-Rob
[1] Running CMUCL-19a in 32-bit mode on a 1.8 GHz Athlon64,
under Linux 2.4.21-20.EL with XFree86 4.3.
-----
Rob Warnock <····@rpw3.org>
627 26th Avenue <URL:http://rpw3.org/>
San Mateo, CA 94403 (650)572-2607
On Thu, 25 Aug 2005 06:02:09 -0500, <····@rpw3.org> wrote:
>
>
> GP lisper <········@clouddancer.com> wrote:
> +---------------
>| > LuisGLopez wrote:
>| >> In the end, it is expected that all the persons share the same state.
>|
>| Since the choice is random, on a sufficiently large torus, it never ends.
>| For instance, Alan's (x-version "localhost" 10 60 60)
> +---------------
>
> Well, I compiled it, which made it go *much* faster[1], and even so
> your "10 60 60" case did indeed run for a long time, but eventually
> [in only the time it took me to read the rest of the thread] the
> whole window turned black. So there. ;-}
Well, several hours later, mine was white :-P
All either result shows is that the "random number generator" is
flawed. Generally they fail a two-point-correlation test, which means
that there is a tendancy to repeat the same number in sequential
outputs. For cases such as this problem, you need to map a very large
number of random states onto a small integer number of states. If
that is done thru a division method, then that gauche hack causes a
huge number of adjacent states to map to the same value. Unless the
pristine prng makes equally huge (and random) jumps into it's next
output, it's foobar. You need a modulus method instead.
--
Program A uses CLOS, Program B is implemented with structs, leading
to a fourfold increase in execution speed. --J. B. Heimatseiten
Gp Lisper wrote:
> Since the choice is random, on a sufficiently large torus, it never
> ends. For instance, Alan's (x-version "localhost" 10 60 60)
Whatever the size of the torus, with probability 1 the game
eventually ends. Proof: let there be N cells, and number them
1..N in such a way that n,n+1 are always neighbours. (This is
always possible.) Then in any consecutive N-1 turns, there
is a constant, very small, but nonzero probability that the
actions in those N-1 turns are:
2 copies from 1.
3 copies from 2.
4 copies from 3.
...
N copies from N-1.
If this ever happens, then afterwards all the colours are
the same and the game is over. Calling that positive but
very small probability p, the probability of its never having
happened in k(N-1) turns is at most (1-p)^k, which tends to 0
as k tends to oo. So the probability of the game not having
finished yet after k(N-1) turns tends to 0 as k -> oo.
Of course, usually the game is over much faster than that,
and it's not hard to prove that either. Here's a sketch of
how.
1. On some turns, nothing happens because our chosen cell
and its neighbour are the same colour. The probability that
this will happen is at most something like 1-1/2N, so let's
pretend that we always select a pair of differently-coloured
cells; this speeds things up by at most a factor of 4N.
2. Whatever pair of cells we choose, we're equally likely
to pick them one way round as the other. One way increases
the number of black cells by 1, the other decreases it by 1.
3. Therefore, apart from the consideration mentioned in #1,
we're just doing a 1-d random walk. That takes, on average,
about N^2/4 turns to finish.
So if any game took more than about 10N^3 turns, I'd suspect
a bad random number generator. Note that *not* finishing in
a reasonable time is what's indicative of a bad RNG!
For the 60*60 case, that means that if it's taking a couple
of million turns then something is probably broken.
--
Gareth McCaughan
.sig under construc
"LuisGLopez" <············@gmail.com> writes:
> (defun situacion-inicial (ancho alto)
> (let ((situacion (make-array (list ancho alto) :initial-element 0)))
> (dotimes (i ancho)
> (dotimes (j alto)
> (setf (aref situacion i j) (random 2))))
> situacion))
In this case, I think it'll be worthwhile to use a bit array; it'll
display nicer, and the various bit-* functions could be used to
combine bit arrays.
(defun situacion-inicial (ancho alto)
(let ((situacion (make-array (list ancho alto) :initial-element 0
:element-type 'bit)))
(dotimes (i ancho)
(dotimes (j alto)
(setf (aref situacion i j) (random 2))))
situacion))
> (defun comprobar (n maximo)
> (when (< n 0) (setf n (- maximo 1)))
> (when (> n maximo) (setf n 0))
> n)
(defun coerce-coordinate (n maximo) (mod n maximo))
With one simple function, you can implement correctly even the case
when n is farther away from the border (if you wanted to take into
account farther neighrbors).
> (defun cambiar-opinion (situacion ancho alto)
> (let ((i (random ancho))
> (j (random alto))
> (d (random 8))
> (in 0)
> (jn 0))
> (cond
> ((= 0 d) (decf in) (decf jn))
> ((= 1 d) (decf in) )
> ((= 2 d) (decf in) (incf jn))
> ((= 3 d) (decf jn))
> ((= 4 d) (incf jn))
> ((= 5 d) (incf in) (decf jn))
> ((= 6 d) (incf in) )
> ((= 7 d) (incf in) (incf jn)))
> (setf in (comprobar in ancho))
> (setf jn (comprobar jn alto))
> (setf (aref situacion i j) (aref situacion in jn))
> situacion))
Instead of this COND, you should use CASE. And it'll be simplier to
process the two axis independtly.
The array dimensions are kept with the array; there's no reason to
pass them along (you're not writing in C ;-)
(defun cambiar-opinion (situacion)
(let* ((ancho (array-dimension situacion 0))
(alto (array-dimension situacion 1))
(i (random ancho))
(j (random alto))
(in i) ; not 0!
(jn j)) ; not 0!
(case (random 3) (0 (decf in)) (1 (incf in)))
(case (random 3) (0 (decf jn)) (1 (incf jn)))
(setf in (coerce-coordinate in ancho))
(setf jn (coerce-coordinate jn alto))
(setf (aref situacion i j) (aref situacion in jn))
situacion))
It's not a bad idea to return the array, but note that since you
modified it, it's not a function, it's a procedure (a function with
side-effects).
Note that I've observed several times with real people that opinions
get swapped instead of copied!
One interesting example was the behavior of selection of icon names in
NeXTSTEP and MS-Windows GUI. At one time, NeXTSTEP had a superior
behavior. But then they copied the behavior of MS-Windows, at the
same time that Microsoft copied NeXTSTEP behavior. On the next
versions they were swapped! :-)
> (defun recuento-opinion (situacion ancho alto)
> (let ((n 0))
> (dotimes (i ancho)
> (dotimes (j alto)
> (when (= 0 (aref situacion i j))
> (incf n))))
> n))
Let's learn a new practical aspect of arrays (useful for low-level
optimization and other global array processings): row-major-aref
Any multi-dimension array can be manipulated as a vector:
(defun recuento-opinion (situacion)
(let ((n 0))
(dotimes (i (array-total-size situacion) n) ; the result is specified here.
(when (zerop (row-major-aref situacion i))
(incf n)))))
dotimes, dolist, take an optional third expression in their first
argument to specify their result.
> (defun correr (&optional (veces 1000) (ancho 10) (alto 10))
> (let ((situacion (situacion-inicial ancho alto)))
> (dotimes (i veces)
> (print situacion)
> (let ((n (recuento-opinion situacion ancho alto)))
> (when (or (zerop n) (= n (* ancho alto)))
> (format t "Congrats! You reach uniformity in ~d steps" i)
> (setf i veces))
> (setf situacion (cambiar-opinion situacion ancho alto))))))
(defun correr (&key (veces 1000) (ancho 10) (alto 10))
(let ((situacion (situacion-inicial ancho alto))
(tamano-populacion (* ancho alto)))
(dotimes (i veces)
(print situacion)
(let ((n (recuento-opinion situacion)))
(when (or (zerop n) (= n tamano-populacion))
(format t "~&Congrats! You reach uniformity in ~d steps" i)
(return-from correr)))
(cambiar-opinion situacion))))
It's almost always better to use keyword arguments instead of optional
arguments. Keywords are not positional and are easier to read:
(correr 10 5 5) vs. (correr :ancho 5 :alto 5 :veces 10)
Note the use of ~& which outputs an optional newline.
Since cambiar-opinion is a procedure, there's no need to reassign
situacion to itself.
> I didn't use any global variable! (Thanks, Pascal!!!!)
Very good!
> What I like more is the "ascii graphics" :-)
You might get more interesting results with different rules.
You can use more than two types of populations (lose the 'bit element
type then).
Instead of changing opinion, imagine people moving, changing
neighborhood (voting with their feet). When they're happy, they don't
move, when they're not happy, they move. There are people who are
happy in homogenous neighborhood (eg with at least N neighbors of same
color), or there are people who like more diversity, happy with less
than P neighbors of the same color.
When there are more than one unhappy persons, then you can swap random
couples of them.
It leads to more interesting behavior and results. Usually, the
populations segregate in two (or N) homogenous countries.
I've got this link, http://www.theatlantic.com/issues/2002/04/rauch.htm
but now it requires a subscription :-( Always take copies of interesting
web bits, you never know when they'll disappear! Otherwise, seach for
Schelling and artificial life.
--
__Pascal Bourguignon__ http://www.informatimago.com/
Nobody can fix the economy. Nobody can be trusted with their finger
on the button. Nobody's perfect. VOTE FOR NOBODY.
LuisGLopez wrote:
> Of course, I don't like the "cond" block; it's too *big*!!! But didn't
> figure out how to make it smaller.
offset by 5, convert to base 3, wrap mod 3, and offset again
CL-USER> (defun neighbour (n)
(multiple-value-bind (quotient remainder)
(floor (+ n 5) 3)
(list (- (mod quotient 3) 1)
(- remainder 1))))
NEIGHBOUR
CL-USER> (dotimes (i 8)
(format t "~&~A ~A" i (neighbour i)))
0 (0 1)
1 (1 -1)
2 (1 0)
3 (1 1)
4 (-1 -1)
5 (-1 0)
6 (-1 1)
7 (0 -1)
buy life insurance, get murdered by maintenance programmer, profit!!!
Alan Crowe
Edinburgh
Scotland
From: Steven E. Harris
Subject: Re: Simulation: Changes of opinion (a little less newbie...)
Date:
Message-ID: <q943bozmips.fsf@xenon.gnostech.com>
Alan Crowe <····@cawtech.freeserve.co.uk> writes:
> offset by 5, convert to base 3, wrap mod 3, and offset again
Crazy. Did you figure that out through inspection?
--
Steven E. Harris
Steven E. Harris
> > offset by 5, convert to base 3, wrap mod 3, and offset again
>
> Crazy. Did you figure that out through inspection?
Well the basic puzzle is to map 0,1,2,3,4,5,6,7,8 onto a 3
by 3 square. So the starting point is to convert to base 3
0 -> 0 0
1 -> 0 1
2 -> 0 2
3 -> 1 0
4 -> 1 1
5 -> 1 2
6 -> 2 0
7 -> 2 1
8 -> 2 2
After that it is basically debugging. We need to offset
everything by one. That leaves 4 mapped to (0 0) which we
don't actually want. But that is not a big deal, the pattern
repeats cyclically, so we add an offset to start at 5.
Which would be fine if we were really converting to base
three, but finding the quotient and remainder with floor
only gets you the first digit of the conversion, so we have
to do the second digit properly by wrapping mod 3.
Not only is there madness in my method, but there is also
method in my madness :-)
--
Alan Crowe
Edinburgh
Scotland