[Jprogramming] Holiday graphics Nr.2 (again)

Wed Dec 23 01:27:56 HKT 2009

That's a really useful site, June!

I can think of all sorts of uses for it.

How about this: http://pastebin.com/m2b4a375c

(Excuse me, Mr Shimura, for uploading your work.)

Ian

On Tue, Dec 22, 2009 at 5:10 PM, June Kim <juneaftn at gmail.com> wrote:
> If there is any problem sending your code through the mailing list, I
> recommend putting them on the wiki site or http://pastebin.com/
>
>
> 2009/12/23 M.Shimura <jcd02773 at nifty.ne.jp>:
>> 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 /jcd02773 at nifty.ne.jp
>> 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
>>
> ----------------------------------------------------------------------
> For information about J forums see http://www.jsoftware.com/forums.htm