I apologize for trouble of e-mail system so send Script again using ? only get random numbers sorry I ever checked on Mac
m.shimura NB. -----------------------cut here----------------- NB. ------------------------------------------------ NB. Title "turtle_circuit.ijs" NB. circuit parade NB. using self driven particle cell and turtle graphics NB. written by SHIMURA Masato /[email protected] NB. 11/Oct./2007 NB. last update 09/Oct./2008 NB. ------------------------------ NB. *usage: asep_run '' NB. appear dialog_box NB. drive once and -> enlarge Screen (mouse drag) NB. ----------------------------------------- NB. using on shell(ijx) NB. *usage: do_turtle_circuit 0.55 NB. p=. 0.55 NB. p is percent of turtle in cells // 0.2<---> 0.8 NB. circuit turtle runs clockwise NB. after 1st operation drag mouse enlarge windows NB. --------------------------------------- require 'turtle' NB. -----util--------------- bare=: ;("1)@,. bare2=: ;("2)@,. expand=: 4 : ' ((I. x) i. i. # x){y,0' expand_box=: 4 : ' ((I. x) i. i. # x){y' NB. usage:1 0 1 0 1 1 expand_box ({@> 3 4 5 6),<0 loose_box=: 3 : '< |: bare2 |:(L:0) y' NB. remove sikiri NB. -------turtle--------------------------------- NB. -------turtle display-------------------- do_turtle_circuit=: 3 : 0 NB. u. 0.5 //p is from 0.2 to 0.75 TMP0=. anal_turtle_circuit y CL0 =. 255 255 255 NB. empty white CL1 =. 0 255 0 NB. A lime CL2 =. 0 172 0 NB. B like Green CL3 =. 255 0 255 NB. change Lane Fuchsia NB. CL4=. 192 192 192 NB. forward car Silver NB. -------------------------- COL0=.(color CL0 fill rt 0),(color CL1 fill rt 0),:color CL3 fill rt 0 NB. Lane A COL1=.(color CL0 fill rt 0),(color CL2 fill rt 0),:color CL3 fill rt 0 NB. Lane B NB. ----color and figure------------- for_ctr. i. 121 do. NB. TIMES do. TMP=.|."1 ; ctr{ TMP0 NB. last to top CLR0=. ({. TMP) { COL0 NB. 30 column fixed CLR1=. ({: TMP) { COL1 NB. 30 column fixed NB. construct program for rectangles J0=. repeat 6 fd 1 rt 60 NB. Hexagon CLR2=. CLR0,. >(# CLR0) #<J0 CLR3=. CLR1,. >(# CLR1) #<J0 NB. ----position------------------- R0=.0 4 66 70 +/ j.3+ 2* >:i.30 NB. tate R1=. (30{. 6+ 2* i. 60)+/ j.>: 0 3 64 68 NB. yoko A0=. ({."1 R1),({: R0),(|. {: "1 R1),|.{. R0 NB. ourtt lane (oikoshi) B0=. (1{"1 R1),(2{ R0),(|.2{"1 R1),|.1{ R0 NB. inner lane (soukou) ht'' NB. hide tuirtle show ;("1),.(B0 start {CLR2),A0 start {CLR3 NB. reverce lane end. ) NB. -----calc --main--------------------------------- anal_turtle_circuit=:3 : 0 NB. e.g. u 0.5 ANS=. <TMP =.(prob_120 y),:prob_120 y for_ctr. i. 120 do. NB. 2 min TMP=. bare y parade_sub {* TMP ANS=. ANS,<TMP end. ANS ) prob_120=: 3 : '(y * 120)> 120?120' NB. ----asep engine---------------------- forward_asep_sub1_circuit =: 3 : 0 NB. alway same size NB. calc ASEP NB. self forward type NB. x is 0/1 by probability IND=. 2 = 2(+/)\ y,{. y COMPARE=.(bare ({@> 1 2) = L:0 +/ y,:IND),.0 +/ ({: COMPARE),: _1|.{. COMPARE ) forward_sub2_circuit=: 3 : 0 NB. self run engine for circuit NB. forward_sub1 is same as straight TX =. forward_asep_sub1_circuit y MKR=. ;({: L:0 y),{. y NB. 0 0,1 0.0 1,1,1-->2 #. is 0/2/1/3 NB. marker select. 2 #. MKR NB. 2 notation case. 2 do. NB. 1 0 is 2 --> may go TX=. ({: TX),}.}:TX NB. remove last to top fcase. do. TX=. }: TX end. NB. not forward case// recursive NB. pecurier circuit /over zone--> assume 1 ) NB. ---zrp engine-------------- parade_sub=: 4 : 0 NB. calc ASEP and ZRP at once NB. go to forward forside if free NB. Usage: X0 parade_sub TMP NB. x is (<0.55),<{@> 0 1 (top barrier) NB. y is boxed numeric PROB =. x NB. X0=. (<0.5),<{@> {."1 PX Y0=. y IND_ZRP0=. PROB index_zrp_sub1 * L:0 Y0 NB. can zrp ASEP0=. forward_sub2_circuit L:0 Y0 NB. done asep = space zrp ZRPIND0=. >:& I. L:0 IND_ZRP0 NB. forward 1 ASEPIND=. I. L:0 ASEP0 NB. congestion ZRPIND=.(-. L:0 ZRPIND0 e. L:0 |. ASEPIND)# L:0 ZRPIND0 NB. adress to zrp if. 1= * +/ ; +/ L:0 ZRPIND e.(L:0) 120 do. NB. position 120 cannot zrp ZRPIND=. (-. L:0 ZRPIND e. (L:0) 120) # L:0 ZRPIND end. NB. remove 120 NB. amend pair is one to one make many combinations AMEND_IND0=.* ; +/ L:0 * L:0 ZRPIND NB. index exsist ZRP NB. react to oneside null AMEND_IND=.;(AMEND_IND0 # 1;0) , L:0 {@> L:0 AMEND_IND0 # ZRPIND select. # * +/ AMEND_IND0 NB. both side null case. 0 do. ANS=. bare ASEP0 fcase. do. NB. INDEX is both or either TMP2=. (2)(AMEND_IND)} L:0 bare ASEP0 NB. write 2--> color pink AMEND_IND2=. |&<: L:0 AMEND_IND ANS=. (0) (AMEND_IND2)} L:0 TMP2 NB. delete own end. ($ L:0 ASEP0) {. L:0 { ANS ) NB. --------new------------ NB. find candidate---- NB. using metropolis random number index_zrp_sub1 =: 4 : 0 NB. find candidate for lane change NB. x is congestion rate // y is TMP (is prob a b lane) CONG=. +/ L:0 INDX=: (1, L:0 }. L:0 -. L:0 y)<;.1 L:0 y NB. search congestio m MAX_CONG=. >./; bare2 CONG MP=. x metropolis_x MAX_CONG if. 0= MP do. ANS=. (# L:0 y) # (L:0) 0 NB. all 0 else. MPIND0=. (i.>: >./ MP) e. MP MPIND=. |. L:0 (# L:0 INDX) {. L:0 MPIND0 ANS=. { bare > INDX *. L:0 MPIND end. ANS ) NB. -------window-form---------------------- ASEP=: 0 : 0 pc asep;pn "ASEP&ZRP"; menupop "File"; menu new "&New" "" "" ""; menu open "&Open" "" "" ""; menusep; menu exit "&Exit" "" "" ""; menupopz; xywh 3 47 51 30;cc PX combobox ws_vscroll; xywh 3 2 56 15;cc board button rightmove; xywh 63 2 40 16;cc draw button;cn "DRAW"; xywh 65 48 33 12;cc end button;cn "END"; xywh 2 24 84 23;cc pxsmall static rightmove bottomscale; pas 6 6;pcenter; rem form end; ) c_name=: 'English' c_head=: '混雑率・小型' c_prob=: '0.2-0.8' c_all=: c_head,LF,c_prob e_name=: '漢字' e_head=: 'Congestion ratio' e_prob=: '0.2-0.8' e_all=: e_head,LF,e_prob asep_draw_button=: 3 : 0 asep_test '' ) set_px=: 3 : 0 wd 'set PX "0.2" "0.3" "0.4" "0.5" "0.55" "0.6" "0.7" "0.8"' wd 'setselect PX 4' ) asep_test=: 3 : 0 do_turtle_circuit ". PX ) asep_run=: 3 : 0 wd ASEP NB. initialize form here wd'setfont board ',font wd'setfont pxsmall ',font btext=: e_name wd'setcaption board *',btext wd'set pxsmall *',e_all set_px '' wd 'pshow;' ) asep_board_button=: 3 : 0 select. btext case. c_name do. btext=: e_name t=. e_all case. e_name do. btext=: c_name t=. c_all end. wd'set pxsmall *',t wd'setcaption board *',btext ) asep_close=: 3 : 0 wd'pclose' ) asep_end_button=: 3 : 0 asep_close'' ) asep_run '' NB. ---------random number---------------- NB. montecarlo monte0=: 4 : ' ((x* y)> y?y) # i.y' NB. 0.5 monte0 100 NB. --motropolis method--- metropolis0=: 4 : 0 NB. metropolise argolythm NB. 0.7 u 1000 NB. not burn-in ANS=.{. TMP1=. 2 {. TMP0=. y ? y for_ctr. (i. y)-2 do. select. 1< RATE=. %/ |. TMP1 NB. px' / pxt case. 1 do. NB. take ANS=. ANS,{: TMP1 TMP1=. (}. TMP1), (2 + ctr){TMP0 fcase. do. if. ((? y)%y) < x do. NB. get prob each time NB.for take using < (not >) ANS=. ANS,{: TMP1 NB. take(same) TMP1=. (}. TMP1), (2 + ctr){TMP0 NB. take(same) else. TMP1=. (}: TMP1),(2 + ctr){ TMP0 end. end. end. NB. --------------------------- ANS NB. nub(~.) adjust head of overrup NB. if null --> find 0=# ans --> 1 ) metropolis_x=: 4 : 0 NB. Usage: 0.55 metropolis_x 6 NB. remove 0 --> 0 NB. if null --> 0 NB. case. 0 -->on using script write skip patarn TMP=. ~. /:~ x metropolis0 y NB. not burn_in and sort select. # TMP case. 0 do. TMP=. 0 NB. null -->0 case. 1 do. if. 1 = TMP do. TMP=. 0 else. TMP=. TMP end. fcase. do. TMP=.( -. TMP e. 0 ) # TMP NB. except 0 if. 0 = # TMP do. TMP=. 0 end. NB. null --> 0 end. TMP ) NB. ---------------------------- NB. E.O.F. ---------------------------------------------------------------------- For information about J forums see http://www.jsoftware.com/forums.htm
