انجمن‌های فارسی اوبونتو
کمک و پشتیبانی => برنامه‌سازی => نویسنده: mrmrn در 19 فروردین 1392، 07:46 ب‌ظ
-
بسم الله.
سلام.
فرض کنید یه فایل رو تو فرترن باز میکنیم و تو هر مرحله یک سری دیتا بهش اضافه میکنیم ولی قبلش میخواهیم چک کنیم که دیتا تکراری نباشه تو همون فایل.چه راهی ساده تره بنظرتون.
الا من یه همچین برنامه ای نوشتم ولی برنامه خطای رسیدن به انتهای فایل رو میده.میخوام بدونم چطوری بگم به فرترن که تو مرحله ای که چک میکنه که دیتا تکراریه یا نه به ته فایل که رسید حلقه رو رها کنه و دیگه ادامه نده؟!
-
من فرترن بلد نیستم ولی توی سی پلاس که eof انتهای فایل رو مشخص میکنه که میشه اون رو توی while گذاشت تا انتهای فایل رو چک کنه و با یک for تکراری بودن رو چک کرد
دنبال دستوری بگرد که بشه باهاش فهمید که به انتهای فایل رسیدی البته فایلهای اسکی فکر کنم با کاراکتر /0 خاتمه پیدا می‌کنن که این رو هم میتونی امتحان کنی
-
INTEGER :: Reason
INTEGER :: a, b, c
DO
READ(*,*,IOSTAT=Reason) a, b, c
IF (Reason > 0) THEN
... something wrong ...
ELSE IF (Reason < 0) THEN
... end of file reached ...
ELSE
... do normal stuff ...
END IF
END DO
-
ممنون معین جان.البته من زیاد ازینی ه نوشتین سر در نیاوردم ولی به کمک راهنماییتون یه چیزایی پیدا کردم:
http://www.cs.mtu.edu/~shene/COURSES/cs201/NOTES/chap04/iostatus.html
من به این نتیجه رسیدم گیر کار جای دیگس.
ببینین یه شبکه در نظر بگیرین که یه متحرک رو این شبکه داره حرکت میکنه و با احتمال مساوی بالا پایین چپ یا راست میره.
حالا این متحرک میخواد نقاطی رو که قبلا رفته تکرار نکنه.پس باید یه جوری باید نقاط قبلی رو به یاد بسپاره.من میخوام دقیقا این رو بنویسم و براش این کد رو زدم:
REAL ran3,r,b,d
INTEGER i,step,s,m,j,a,x,y
open(12,file="self12.txt")
c open(14,file="self14.txt")
READ(*,*) step
s=0
m=0
Do i=1,step
r=ran3(idum)
if (r .gt.0.75 ) then
Do j=1,i
READ (12,88) a,x,y,b
if (s+1==x .and. m==y) then
write (12,88) i,s+1,m,d
goto 66
end if
enddo
s=s+1
endif
if (r .gt. 0.5 .and. 0.75 .gt. r ) then
Do j=1,i
READ (12,88) a,x,y,b
if (s-1==x .and. m==y) then
write (12,88) i,s-1,m,d
goto 66
end if
enddo
s=s-1
end if
if (r .gt. 0.25 .and. 0.5 .gt. r ) then
Do j=1,i
READ (12,88) a,x,y,b
if (s==x .and. m+1==y) then
write (12,88) i,s,m+1,d
goto 66
end if
enddo
m=m+1
end if
if ( 0.25 .gt. r ) then
Do j=1,i
READ (12,88) a,x,y,b
if (s==x .and. m-1==y) then
write (12,88) i,s,m-1,d
goto 66
end if
enddo
m=m-1
end if
d=((m**2+s**2))**(0.5)
c write (14,*) i,s,m,d
write (12,88) i,s,m,d
66 END DO
88 format (/,I4,I4,I4,F8.3)
end
!!!!!!!!!!!!!!RAN3(idum) !!!!!!!!!!!!!!!!!!
FUNCTION ran3(idum)
INTEGER idum
INTEGER MBIG,MSEED,MZ
C REAL MBIG,MSEED,MZ
REAL ran3,FAC
PARAMETER (MBIG=1000000000,MSEED=161803398,MZ=0,FAC=1./MBIG)
C PARAMETER (MBIG=4000000.,MSEED=1618033.,MZ=0.,FAC=1./MBIG)
INTEGER i,iff,ii,inext,inextp,k
INTEGER mj,mk,ma(55)
C REAL mj,mk,ma(55)
SAVE iff,inext,inextp,ma
DATA iff /0/
if(idum.lt.0.or.iff.eq.0)then
iff=1
mj=MSEED-iabs(idum)
mj=mod(mj,MBIG)
ma(55)=mj
mk=1
do 11 i=1,54
ii=mod(21*i,55)
ma(ii)=mk
mk=mj-mk
if(mk.lt.MZ)mk=mk+MBIG
mj=ma(ii)
11 continue
do 13 k=1,4
do 12 i=1,55
ma(i)=ma(i)-ma(1+mod(i+30,55))
if(ma(i).lt.MZ)ma(i)=ma(i)+MBIG
12 continue
13 continue
inext=0
inextp=31
idum=1
endif
inext=inext+1
if(inext.eq.56)inext=1
inextp=inextp+1
if(inextp.eq.56)inextp=1
mj=ma(inext)-ma(inextp)
if(mj.lt.MZ)mj=mj+MBIG
ma(inext)=mj
ran3=mj*FAC
return
END
ولی تنها دوخط تو فایل خروجی میمونه و برنامه سریع ناقص تموم میشه!!
-
خب.ایندفعه اومدم و از آرایه کمک گرفتم ولی همچنان یه جای کار میلنگه!
REAL ran3,r,b,d
INTEGER i,step,s,m,j,a,x,y, mat(1000,2),test(1,2)
open(12,file="selfmat2d.txt")
READ(*,*) step
s=0
m=0
Do k=1,1000
mat(k,1)=0
mat(k,2)=0
enddo
Do i=1,step
r=ran3(i)
if (r .gt.0.75 ) then
j=1
test(1,1)= s+1
test(1,2)= m
Do j=1,i
if (test(1,1)==mat(j,1) .and. test(1,2)==mat(j,2)) then
goto 66
endif
enddo
s=s+1
endif
if (r .gt. 0.5 .and. 0.75 .gt. r ) then
j=1
test(1,1)= s-1
test(1,2)= m
Do j=1,i
if (test(1,1)==mat(j,1) .and. test(1,2)==mat(j,2)) then
goto 66
end if
enddo
s=s-1
end if
if (r .gt. 0.25 .and. 0.5 .gt. r ) then
j=1
test(1,1)= s
test(1,2)= m+1
Do j=1,i
if (test(1,1)==mat(j,1) .and. test(1,2)==mat(j,2)) then
goto 66
end if
enddo
m=m+1
end if
if ( 0.25 .gt. r ) then
j=1
test(1,1)= s
test(1,2)= m-1
Do j=1,i
if (test(1,1)==mat(j,1) .and. test(1,2)==mat(j,2)) then
goto 66
end if
enddo
m=m-1
end if
d=((m**2+s**2))**(0.5)
write (12,88) i,s,m,d
mat(i,1)=s
mat(i,2)=m
66 END DO
88 format (I4,I4,I4,F8.3)
end
!!!!!!!!!!!!!!RAN3(idum) !!!!!!!!!!!!!!!!!!
FUNCTION ran3(idum)
INTEGER idum
INTEGER MBIG,MSEED,MZ
C REAL MBIG,MSEED,MZ
REAL ran3,FAC
PARAMETER (MBIG=1000000000,MSEED=161803398,MZ=0,FAC=1./MBIG)
C PARAMETER (MBIG=4000000.,MSEED=1618033.,MZ=0.,FAC=1./MBIG)
INTEGER i,iff,ii,inext,inextp,k
INTEGER mj,mk,ma(55)
C REAL mj,mk,ma(55)
SAVE iff,inext,inextp,ma
DATA iff /0/
if(idum.lt.0.or.iff.eq.0)then
iff=1
mj=MSEED-iabs(idum)
mj=mod(mj,MBIG)
ma(55)=mj
mk=1
do 11 i=1,54
ii=mod(21*i,55)
ma(ii)=mk
mk=mj-mk
if(mk.lt.MZ)mk=mk+MBIG
mj=ma(ii)
11 continue
do 13 k=1,4
do 12 i=1,55
ma(i)=ma(i)-ma(1+mod(i+30,55))
if(ma(i).lt.MZ)ma(i)=ma(i)+MBIG
12 continue
13 continue
inext=0
inextp=31
idum=1
endif
inext=inext+1
if(inext.eq.56)inext=1
inextp=inextp+1
if(inextp.eq.56)inextp=1
mj=ma(inext)-ma(inextp)
if(mj.lt.MZ)mj=mj+MBIG
ma(inext)=mj
ran3=mj*FAC
return
END
-
:o :o
فرترن ؟
داداش میون این همه \یمبر جرجیس و انتخاب کردین :D
-
:o :o
فرترن ؟
داداش میون این همه \یمبر جرجیس و انتخاب کردین :D
مثلا ایشون رو نصیحت کردی؟
حتما نیاز داشته که داره از فرترن استفاده میکنه! فرترن برای کار با ماتریس ها قوی و سریعه!
-
:o :o
فرترن ؟
داداش میون این همه \یمبر جرجیس و انتخاب کردین :D
دوست من،
هر کسی با توجه به یه هدف خاص سمت برنامه‌نویسی و گنو/لینوکس می‌یاد. یادگیری زبون فورترن برای کسایی که کارهای محاسباتی سنگین می‌کنن یکی از واجبات هست :)
یه مثال از مکانیک سازه‌ها برات می زنم. وقتی که ما مثلاً یه ساختمان n طبقه داریم و میخواهیم ببینیم که تحت نیروهای وارد بر اون چه عکس‌العملی از خود نشون میده، (نیروهای باد، زلزله، وزن و ...) می‌تونیم از رایانه کمک بگیریم و باید ساختمون رو یه جوری به خورد رایانه بدیم (مدل سازی) برای این‌کار یکی از مدل‌های پیشنهادی استفاده از مدل mass-spring-damper (جرم-فنر-میراگر)هست. و بعد از مدل سازی یکی از روش‌های حل به صورت عددی استفاده از finite element (اجزا محدود) هست، و مبنای اجزا محدود بر ماتریسها و محاسبات ماتریسی هست. :) خلاصه بعد از طی چندمرحله ممکنه به یه معادله‌ی ماتریسی ۱۰۰ هزار در ۱۰۰ هزار برسیم. اون موقع هست که درود می‌فرستی بر روح پر فتوح خالق‌ها و توسعه‌دهنده‌های فورترن :)
-
ببینین یه شبکه در نظر بگیرین که یه متحرک رو این شبکه داره حرکت میکنه و با احتمال مساوی بالا پایین چپ یا راست میره.
حالا این متحرک میخواد نقاطی رو که قبلا رفته تکرار نکنه.پس باید یه جوری باید نقاط قبلی رو به یاد بسپاره.
رشته‌ات چیه عزیزم؟ علمی‌تر توضیح می‌دی؟
-
خوب احتمال اینکه متحرک بتونه همه ی خونه های جدول رو بپیمایه و هیچ جایی گیر نکنه بسیار پایینه . متحرک پس از چند حرکت ( اگر این جابجایی ها با دلیل نباشه و بختکی انجام بشه ) یک گوشه گیر میفته .
شما یک ماتریس بساز . همه ی خونه های اونو صفر بده . هر خونه ای که پیموده شد رو 1 بکن . بهش بگو خونه ای رو میتونه بره که 0 باشه .
در پایان ماتریس رو چاپ کن
=========================
یک راه بهتر :
همه ی خونه ها رو صفر بده
توی هر خونه که میره با توجه به گامی که درش هستیم ( اگر نخستین گام هست 1 ، اگر گام دهم هست 10 ) شماره گام رو به خونه بده . اینجوری زمانی که ماتریس چاپ بشه میتونی بفهمی چجوری ماتریس رو پیموده
-
ممنون از همه.
من با ماتریس هم نوشتم ولی از یه if ایراد میگرفت که من نفهمیدم.
@ سلمان
رشتم فیزیک.
اینم توضیح:
http://en.wikipedia.org/wiki/Self-avoiding_walk
البته من در دوبعدش رو میخوام.
@ doomhammer
اینکه یه جا گیر میکنه درسته به شرط اینکه خیلی کوچیک باشه شبکه مون.
من با ماتریسها اومدم یه ماتریس دادم و هر خونه ای رفته رو ریختم توش.بعد گفتم بیا و هر خونه ای رو میخوای بری چک کن تو اون ماتریسه هست؟
اگر نیست برو.اگر هست که یه جهت دیگه انتخاب کن.
برنامه ای هم که تو پست اول گذاشتم ویرایش کردم.
این بدون ماتریس:
REAL ran3,r,b,d
INTEGER i,step,s,m,j,a,x,y
open(12,file="self12.txt")
open(14,file="self14.txt")
READ(*,*) step
s=0
m=0
Do k=1,4*step+1
write (12,88) 0,0,0,0.0
enddo
rewind 12
Do i=1,step
rewind 12
r=ran3(i)
if (r .gt.0.75 ) then
Do j=1,i
rewind 12
READ (12,88) a,x,y,b
if (s+1==x .and. m==y) then
c rewind 12
c write (12,88) i,s+1,m,d
goto 66
end if
enddo
s=s+1
endif
if (r .gt. 0.5 .and. 0.75 .gt. r ) then
Do j=1,i
rewind 12
READ (12,88) a,x,y,b
if (s-1==x .and. m==y) then
c rewind 12
c write (12,88) i,s-1,m,d
goto 66
end if
enddo
s=s-1
end if
if (r .gt. 0.25 .and. 0.5 .gt. r ) then
Do j=1,i
rewind 12
READ (12,88) a,x,y,b
if (s==x .and. m+1==y) then
c rewind 12
c write (12,88) i,s,m+1,d
goto 66
end if
enddo
m=m+1
end if
if ( 0.25 .gt. r ) then
Do j=1,i
rewind 12
READ (12,88) a,x,y,b
if (s==x .and. m-1==y) then
c rewind 12
c write (12,88) i,s,m-1,d
goto 66
end if
enddo
m=m-1
end if
d=((m**2+s**2))**(0.5)
write (14,*) i,s,m,d
write (12,88) i,s,m,d
66 END DO
88 format (I4,I4,I4,F8.3)
end
!!!!!!!!!!!!!!RAN3(idum) !!!!!!!!!!!!!!!!!!
FUNCTION ran3(idum)
INTEGER idum
INTEGER MBIG,MSEED,MZ
C REAL MBIG,MSEED,MZ
REAL ran3,FAC
PARAMETER (MBIG=1000000000,MSEED=161803398,MZ=0,FAC=1./MBIG)
C PARAMETER (MBIG=4000000.,MSEED=1618033.,MZ=0.,FAC=1./MBIG)
INTEGER i,iff,ii,inext,inextp,k
INTEGER mj,mk,ma(55)
C REAL mj,mk,ma(55)
SAVE iff,inext,inextp,ma
DATA iff /0/
if(idum.lt.0.or.iff.eq.0)then
iff=1
mj=MSEED-iabs(idum)
mj=mod(mj,MBIG)
ma(55)=mj
mk=1
do 11 i=1,54
ii=mod(21*i,55)
ma(ii)=mk
mk=mj-mk
if(mk.lt.MZ)mk=mk+MBIG
mj=ma(ii)
11 continue
do 13 k=1,4
do 12 i=1,55
ma(i)=ma(i)-ma(1+mod(i+30,55))
if(ma(i).lt.MZ)ma(i)=ma(i)+MBIG
12 continue
13 continue
inext=0
inextp=31
idum=1
endif
inext=inext+1
if(inext.eq.56)inext=1
inextp=inextp+1
if(inextp.eq.56)inextp=1
mj=ma(inext)-ma(inextp)
if(mj.lt.MZ)mj=mj+MBIG
ma(inext)=mj
ran3=mj*FAC
return
END
این هم ماتریسیش.البته اینی که شما میگین خیلی ایده بهتریه ولی مثلا برای ۱۰۰۰۰۰*۱۰۰۰۰ فکر کنم کم بیاره نه؟
REAL ran3,r,b,d
INTEGER i,step,s,m,j,a,x,y, mat(1000,2),test(1,2)
open(12,file="selfmat2d.txt")
READ(*,*) step
s=0
m=0
Do k=1,1000
mat(k,1)=0
mat(k,2)=0
enddo
Do i=1,step
r=ran3(i)
if (r .gt.0.75 ) then
j=1
test(1,1)= s+1
test(1,2)= m
Do j=1,i
if (test(1,1)==mat(j,1) .and. test(1,2)==mat(j,2)) then
goto 66
endif
enddo
s=s+1
endif
if (r .gt. 0.5 .and. 0.75 .gt. r ) then
j=1
test(1,1)= s-1
test(1,2)= m
Do j=1,i
if (test(1,1)==mat(j,1) .and. test(1,2)==mat(j,2)) then
goto 66
end if
enddo
s=s-1
end if
if (r .gt. 0.25 .and. 0.5 .gt. r ) then
j=1
test(1,1)= s
test(1,2)= m+1
Do j=1,i
if (test(1,1)==mat(j,1) .and. test(1,2)==mat(j,2)) then
goto 66
end if
enddo
m=m+1
end if
if ( 0.25 .gt. r ) then
j=1
test(1,1)= s
test(1,2)= m-1
Do j=1,i
if (test(1,1)==mat(j,1) .and. test(1,2)==mat(j,2)) then
goto 66
end if
enddo
m=m-1
end if
d=((m**2+s**2))**(0.5)
write (12,88) i,s,m,d
mat(i,1)=s
mat(i,2)=m
66 END DO
88 format (I4,I4,I4,F8.3)
end
!!!!!!!!!!!!!!RAN3(idum) !!!!!!!!!!!!!!!!!!
FUNCTION ran3(idum)
INTEGER idum
INTEGER MBIG,MSEED,MZ
C REAL MBIG,MSEED,MZ
REAL ran3,FAC
PARAMETER (MBIG=1000000000,MSEED=161803398,MZ=0,FAC=1./MBIG)
C PARAMETER (MBIG=4000000.,MSEED=1618033.,MZ=0.,FAC=1./MBIG)
INTEGER i,iff,ii,inext,inextp,k
INTEGER mj,mk,ma(55)
C REAL mj,mk,ma(55)
SAVE iff,inext,inextp,ma
DATA iff /0/
if(idum.lt.0.or.iff.eq.0)then
iff=1
mj=MSEED-iabs(idum)
mj=mod(mj,MBIG)
ma(55)=mj
mk=1
do 11 i=1,54
ii=mod(21*i,55)
ma(ii)=mk
mk=mj-mk
if(mk.lt.MZ)mk=mk+MBIG
mj=ma(ii)
11 continue
do 13 k=1,4
do 12 i=1,55
ma(i)=ma(i)-ma(1+mod(i+30,55))
if(ma(i).lt.MZ)ma(i)=ma(i)+MBIG
12 continue
13 continue
inext=0
inextp=31
idum=1
endif
inext=inext+1
if(inext.eq.56)inext=1
inextp=inextp+1
if(inextp.eq.56)inextp=1
mj=ma(inext)-ma(inextp)
if(mj.lt.MZ)mj=mj+MBIG
ma(inext)=mj
ran3=mj*FAC
return
END
-
چه شاخه ای از فیزیک؟ راستی جیانت4 رو ابونتو نصب کردیمwien2kهم از بچه های دانشگاه صنعتی اصفهان تو ابونتو نصبیده.خواستی ورک شاپ مشهدم برات میفرستم
-
همینو با آرایه های سی هم میتونید بنویسید مگر اینکه دلیلی برای پافشاری بر فورترن داشته باشید
-
همینو با آرایه های سی هم میتونید بنویسید مگر اینکه دلیلی برای پافشاری بر فورترن داشته باشید
به سی چندان وارد نیستم.
ایدتون رو سریع نوشتم.الان نمیدونم چرا در جهت افقی گاهی تکراری میره ولی عمودی نه؟!
با اینکه هردو عین همه شرایطشون:
REAL ran3,r,b,d
INTEGER i,step,s,m,j,a,x,y, mat(1000,1000)
open(12,file="selfmat2d.txt")
READ(*,*) step
s=0
m=0
Do k=1,step/2
do j =1,step/2
mat(k,j)=0
enddo
enddo
Do i=1,step
r=ran3(i)
if (r .gt.0.75 ) then
if (mat(s+1,m)==0 ) then
mat(s+1,m)=i
s=s+1
write (12,88) i,s,m,d
endif
endif
if (r .gt. 0.5 .and. 0.75 .gt. r ) then
if (mat(s-1,m)==0 ) then
mat(s-1,m)=i
s=s-1
write (12,88) i,s,m,d
end if
endif
if (r .gt. 0.25 .and. 0.5 .gt. r ) then
if (mat(s,m+1)==0 ) then
mat(s,m+1)=i
m=m+1
write (12,88) i,s,m,d
end if
endif
if ( 0.25 .gt. r ) then
if (mat(s,m-1)==0 ) then
mat(1,m-1)=i
m=m-1
write (12,88) i,s,m,d
end if
endif
d=((m**2+s**2))**(0.5)
c write (12,88) i,s,m,d
66 END DO
88 format (I4,I4,I4,F8.3)
end
!!!!!!!!!!!!!!RAN3(idum) !!!!!!!!!!!!!!!!!!
FUNCTION ran3(idum)
INTEGER idum
INTEGER MBIG,MSEED,MZ
C REAL MBIG,MSEED,MZ
REAL ran3,FAC
PARAMETER (MBIG=1000000000,MSEED=161803398,MZ=0,FAC=1./MBIG)
C PARAMETER (MBIG=4000000.,MSEED=1618033.,MZ=0.,FAC=1./MBIG)
INTEGER i,iff,ii,inext,inextp,k
INTEGER mj,mk,ma(55)
C REAL mj,mk,ma(55)
SAVE iff,inext,inextp,ma
DATA iff /0/
if(idum.lt.0.or.iff.eq.0)then
iff=1
mj=MSEED-iabs(idum)
mj=mod(mj,MBIG)
ma(55)=mj
mk=1
do 11 i=1,54
ii=mod(21*i,55)
ma(ii)=mk
mk=mj-mk
if(mk.lt.MZ)mk=mk+MBIG
mj=ma(ii)
11 continue
do 13 k=1,4
do 12 i=1,55
ma(i)=ma(i)-ma(1+mod(i+30,55))
if(ma(i).lt.MZ)ma(i)=ma(i)+MBIG
12 continue
13 continue
inext=0
inextp=31
idum=1
endif
inext=inext+1
if(inext.eq.56)inext=1
inextp=inextp+1
if(inextp.eq.56)inextp=1
mj=ma(inext)-ma(inextp)
if(mj.lt.MZ)mj=mj+MBIG
ma(inext)=mj
ran3=mj*FAC
return
END
اینم یه سری خروجی.
ردیف اول که گام هست.
دومی افقی و سومی عمودی.چهارمی هم فاصله از مبدا
1 0 1 0.000
2 -1 1 1.000
5 -2 1 1.414
6 -3 1 2.236
8 -3 2 3.162
9 -2 2 3.606
10 -2 3 2.828
11 -3 3 3.606
12 -3 4 4.243
13 -4 4 5.000
14 -4 3 5.657
16 -5 3 5.000
17 -4 3 5.831
18 -4 2 5.000
19 -5 2 4.472
20 -6 2 5.385
21 -7 2 6.325
22 -7 1 7.280
24 -8 1 7.071
25 -7 1 8.062
26 -6 1 7.071
34 -5 1 6.083
36 -4 1 5.099
55 -4 2 4.123
پی نوشت:
اشتباه کردم.عمودی هم تکرار میکنه.
مقلا تو گام ۵۵ رفته به خونه ای که گام ۱۸ رفته بوده!!
عجیبه واقعا!!
مثلا تو ۲۲ گام از ۳۶ تا ۵۵ خونه تکراری نره بعد یهو بیاد بره یه خونه تکراری؟
-
چه شاخه ای از فیزیک؟ راستی جیانت4 رو ابونتو نصب کردیمwien2kهم از بچه های دانشگاه صنعتی اصفهان تو ابونتو نصبیده.خواستی ورک شاپ مشهدم برات میفرستم
ممنون.
هسته ای ام.
البته نصب geant4 در آرچ که یک تک فرمان هست.
در اوبونتو هم راحت باید باشه.
شما کجاهستین که ازتون بگیرمش؟!اون آقا رو هم نمیشناسم!!
-
من همدانم.میتونم بزارم برا دانلود یابفرستم بیاد اصفهان از آقای عبدالمالکی یا مهندس صدری تو دانشگاه صنعتی اصفهان بگیرین.من هم هسته ای هستم
-
ممنون از همه.
من با ماتریس هم نوشتم ولی از یه if ایراد میگرفت که من نفهمیدم.
@ سلمان
رشتم فیزیک.
اینم توضیح:
http://en.wikipedia.org/wiki/Self-avoiding_walk
البته من در دوبعدش رو میخوام.
@ doomhammer
اینکه یه جا گیر میکنه درسته به شرط اینکه خیلی کوچیک باشه شبکه مون.
من با ماتریسها اومدم یه ماتریس دادم و هر خونه ای رفته رو ریختم توش.بعد گفتم بیا و هر خونه ای رو میخوای بری چک کن تو اون ماتریسه هست؟
اگر نیست برو.اگر هست که یه جهت دیگه انتخاب کن.
برنامه ای هم که تو پست اول گذاشتم ویرایش کردم.
این بدون ماتریس:
REAL ran3,r,b,d
INTEGER i,step,s,m,j,a,x,y
open(12,file="self12.txt")
open(14,file="self14.txt")
READ(*,*) step
s=0
m=0
Do k=1,4*step+1
write (12,88) 0,0,0,0.0
enddo
rewind 12
Do i=1,step
rewind 12
r=ran3(i)
if (r .gt.0.75 ) then
Do j=1,i
rewind 12
READ (12,88) a,x,y,b
if (s+1==x .and. m==y) then
c rewind 12
c write (12,88) i,s+1,m,d
goto 66
end if
enddo
s=s+1
endif
if (r .gt. 0.5 .and. 0.75 .gt. r ) then
Do j=1,i
rewind 12
READ (12,88) a,x,y,b
if (s-1==x .and. m==y) then
c rewind 12
c write (12,88) i,s-1,m,d
goto 66
end if
enddo
s=s-1
end if
if (r .gt. 0.25 .and. 0.5 .gt. r ) then
Do j=1,i
rewind 12
READ (12,88) a,x,y,b
if (s==x .and. m+1==y) then
c rewind 12
c write (12,88) i,s,m+1,d
goto 66
end if
enddo
m=m+1
end if
if ( 0.25 .gt. r ) then
Do j=1,i
rewind 12
READ (12,88) a,x,y,b
if (s==x .and. m-1==y) then
c rewind 12
c write (12,88) i,s,m-1,d
goto 66
end if
enddo
m=m-1
end if
d=((m**2+s**2))**(0.5)
write (14,*) i,s,m,d
write (12,88) i,s,m,d
66 END DO
88 format (I4,I4,I4,F8.3)
end
!!!!!!!!!!!!!!RAN3(idum) !!!!!!!!!!!!!!!!!!
FUNCTION ran3(idum)
INTEGER idum
INTEGER MBIG,MSEED,MZ
C REAL MBIG,MSEED,MZ
REAL ran3,FAC
PARAMETER (MBIG=1000000000,MSEED=161803398,MZ=0,FAC=1./MBIG)
C PARAMETER (MBIG=4000000.,MSEED=1618033.,MZ=0.,FAC=1./MBIG)
INTEGER i,iff,ii,inext,inextp,k
INTEGER mj,mk,ma(55)
C REAL mj,mk,ma(55)
SAVE iff,inext,inextp,ma
DATA iff /0/
if(idum.lt.0.or.iff.eq.0)then
iff=1
mj=MSEED-iabs(idum)
mj=mod(mj,MBIG)
ma(55)=mj
mk=1
do 11 i=1,54
ii=mod(21*i,55)
ma(ii)=mk
mk=mj-mk
if(mk.lt.MZ)mk=mk+MBIG
mj=ma(ii)
11 continue
do 13 k=1,4
do 12 i=1,55
ma(i)=ma(i)-ma(1+mod(i+30,55))
if(ma(i).lt.MZ)ma(i)=ma(i)+MBIG
12 continue
13 continue
inext=0
inextp=31
idum=1
endif
inext=inext+1
if(inext.eq.56)inext=1
inextp=inextp+1
if(inextp.eq.56)inextp=1
mj=ma(inext)-ma(inextp)
if(mj.lt.MZ)mj=mj+MBIG
ma(inext)=mj
ran3=mj*FAC
return
END
این هم ماتریسیش.البته اینی که شما میگین خیلی ایده بهتریه ولی مثلا برای ۱۰۰۰۰۰*۱۰۰۰۰ فکر کنم کم بیاره نه؟
REAL ran3,r,b,d
INTEGER i,step,s,m,j,a,x,y, mat(1000,2),test(1,2)
open(12,file="selfmat2d.txt")
READ(*,*) step
s=0
m=0
Do k=1,1000
mat(k,1)=0
mat(k,2)=0
enddo
Do i=1,step
r=ran3(i)
if (r .gt.0.75 ) then
j=1
test(1,1)= s+1
test(1,2)= m
Do j=1,i
if (test(1,1)==mat(j,1) .and. test(1,2)==mat(j,2)) then
goto 66
endif
enddo
s=s+1
endif
if (r .gt. 0.5 .and. 0.75 .gt. r ) then
j=1
test(1,1)= s-1
test(1,2)= m
Do j=1,i
if (test(1,1)==mat(j,1) .and. test(1,2)==mat(j,2)) then
goto 66
end if
enddo
s=s-1
end if
if (r .gt. 0.25 .and. 0.5 .gt. r ) then
j=1
test(1,1)= s
test(1,2)= m+1
Do j=1,i
if (test(1,1)==mat(j,1) .and. test(1,2)==mat(j,2)) then
goto 66
end if
enddo
m=m+1
end if
if ( 0.25 .gt. r ) then
j=1
test(1,1)= s
test(1,2)= m-1
Do j=1,i
if (test(1,1)==mat(j,1) .and. test(1,2)==mat(j,2)) then
goto 66
end if
enddo
m=m-1
end if
d=((m**2+s**2))**(0.5)
write (12,88) i,s,m,d
mat(i,1)=s
mat(i,2)=m
66 END DO
88 format (I4,I4,I4,F8.3)
end
!!!!!!!!!!!!!!RAN3(idum) !!!!!!!!!!!!!!!!!!
FUNCTION ran3(idum)
INTEGER idum
INTEGER MBIG,MSEED,MZ
C REAL MBIG,MSEED,MZ
REAL ran3,FAC
PARAMETER (MBIG=1000000000,MSEED=161803398,MZ=0,FAC=1./MBIG)
C PARAMETER (MBIG=4000000.,MSEED=1618033.,MZ=0.,FAC=1./MBIG)
INTEGER i,iff,ii,inext,inextp,k
INTEGER mj,mk,ma(55)
C REAL mj,mk,ma(55)
SAVE iff,inext,inextp,ma
DATA iff /0/
if(idum.lt.0.or.iff.eq.0)then
iff=1
mj=MSEED-iabs(idum)
mj=mod(mj,MBIG)
ma(55)=mj
mk=1
do 11 i=1,54
ii=mod(21*i,55)
ma(ii)=mk
mk=mj-mk
if(mk.lt.MZ)mk=mk+MBIG
mj=ma(ii)
11 continue
do 13 k=1,4
do 12 i=1,55
ma(i)=ma(i)-ma(1+mod(i+30,55))
if(ma(i).lt.MZ)ma(i)=ma(i)+MBIG
12 continue
13 continue
inext=0
inextp=31
idum=1
endif
inext=inext+1
if(inext.eq.56)inext=1
inextp=inextp+1
if(inextp.eq.56)inextp=1
mj=ma(inext)-ma(inextp)
if(mj.lt.MZ)mj=mj+MBIG
ma(inext)=mj
ran3=mj*FAC
return
END
کسی ایده ای نداره که چرا این متحرک ما وقتی بهش میگی ۵۰۰ گام از ۵۰ گام بیشتر نمیره؟ این یعنی میفهمه که خونه تکراری نباید بره ولی چرا قبلش خونه تکراری رفته؟