정보
-
업무명 : 포트란 끝말잇기 자가 학습 알고리즘
-
작성자 : 박진만
-
작성일 : 2019-07-28
-
설 명 : word chain 자가 학습 코드
-
수정이력 :
내용
[개요]
-
안녕하세요? 웹 개발 및 연구 개발을 담당하고 있는 해솔입니다.
-
포트란 (Fortran)을 이용하여 끝말잇기 자가 학습 알고리즘 소스 코드를 소개해 드리고자 합니다.
[특징]
-
고속으로 자가 학습하기 위해서 포트란 (Fortran) 처리 기술이 요구되며 이 프로그램은 이러한 목적을 달성하기 위한 소프트웨어
[기능]
-
끝말잇기를 위한 자가 학습 알고리즘 소스 코드 공유
[활용 자료]
-
없음
[자료 처리 방안 및 활용 분석 기법]
-
없음
[사용법]
-
작업 환경 구축
-
소스 코드 컴파일 (gfortran *.f90)
-
소스 코드 실행 (./a.out)
-
실행 결과 확인
[사용 OS]
-
Linux (CentOS v7.0)
-
VMware Workstation Pro v15.5
[사용 언어]
-
Fortran
소스 코드
[전체]
character,dimension(2000000) :: word*80,word_end*2 !word array
character,dimension(2000000) :: duword*80 !word array (두음)
character :: tword*6,oword*6 !word 문법할당
character,dimension(2000000) :: doword*2 !두음법칙
character :: ow1*80,ow2*80 !두음법칙 할당변수
integer,dimension(2000000) :: num !word number
integer :: c !total word number
character,dimension(1000000) :: player1*80,player2*80 !set player
character :: p*80,p1*80 !set player value
integer,dimension(1000000) :: po !word number save
integer :: cvalue !p word
integer,dimension(1000000) :: player1count,player2count
integer :: svalue,jerry !start number
integer :: gvalue !go number
character :: pp*6,winword*80,lostword*80,winword1*2,lostword1*2
character,dimension(1000000) :: dumi*80,dumi1*80,ww1*80,ww2*80
character,dimension(1000000) :: saveword*80,saveword5*80,saveword4*80,saveword3*80,saveword2*80,saveword1*80
integer,dimension(1000000) :: savenum,savenum1,savenum2,savenum3,savenum4,savenum5
integer,dimension(1000000) :: nturn,ableword
integer,dimension(1000000) :: p1acount,p2acount
real,dimension(200000) :: point !win per
REAL*8,dimension(10000,10000) :: r !random value setting
integer :: i,j,k,ii,jj,ki,kj,kk,kkk,kki,xx,xy,yx,xz,yy,yz,zx,zy,zz,uu,uv,uw,vu,vv,vw,wu,wv,ww !do value
integer :: r1,r2,dd !r value
real :: c1,perk,gvalue1
integer :: turn,alreadycount,acount,totalcount,acounta !count value
integer :: acount1,acount2,acount3,acount4,acount5
integer :: nt1,aa,bb,cc,enumber,snum
character,dimension(200000,5) :: mmm
real,dimension(200000,5) :: mmm1,mmm2,mmm3,mmm4
integer,dimension(200000,5) :: mmm5
integer,dimension(10) :: s
character,dimension(5) :: cs*2
integer :: think1,think2
character,dimension(100) :: cthink1*2,cthink2*2
real,dimension(2000000) :: totalgame1,wingame1,lostgame1,winper1,totalgame2,wingame2,lostgame2,winper2
integer,dimension(2000000) :: score1,score2
integer,dimension(5) :: acountn
integer :: longing,yj,asdasd
character :: test1*6,test2*6
CALL random_seed() !#
CALL RANDOM_NUMBER(r) !#
!!!!!!!!!!!!!!!file name!!!!!!!!!!!!!!!!
cs(1)='s1'
cs(2)='s2'
cs(3)='s3'
cs(4)='s4'
cs(5)='s5'
!!!!!!!!!!!!!!!file name!!!!!!!!!!!!!!!!
totalcount=0
c=427923
open(103,file='./b/saveplayer1.txt')
open(104,file='./b/saveplayer2.txt')
!!!!!!!set score!!!!!!!!!
do i=1,c
read(103,'(a80,1x,4f10.3,i10)')ww1(i),totalgame1(i),wingame1(i),lostgame1(i),winper1(i),score1(i)
read(104,'(a80,1x,4f10.3,i10)')ww2(i),totalgame2(i),wingame2(i),lostgame2(i),winper2(i),score2(i)
score1(i)=(score1(i)+score2(i))/2
score2(i)=(score1(i)+score2(i))/2
enddo
close(103)
close(104)
open(105,file='./b/saveplayer1.txt')
write(*,*)'==============='
read(*,*)asdasd
!!!!!!set score!!!!!!!!!
think1=0
think2=0
do i=1,c
read(105,'(a80)')word(i)
p(1:80)=ww1(i)
do j=1,80
if(p(j:j)=='')then
tword(5:6)=p(j-2:j-1)
goto 11
endif
enddo
11 if(tword(5:6)=='롭'.or.tword(5:6)=='놉')then
score1(i)=210000
score2(i)=210000
write(*,*)tword(5:6)
endif
word_end(i)=tword(5:6)
if(tword(5:6)=='라')then
oword(1:2)='나'
elseif(tword(5:6)=='락')then
oword(1:2)='낙'
elseif(tword(5:6)=='릴')then
oword(1:2)='일'
elseif(tword(5:6)=='를')then
oword(1:2)='늘'
elseif(tword(5:6)=='랗')then
oword(1:2)='낳'
elseif(tword(5:6)=='란')then
oword(1:2)='난'
elseif(tword(5:6)=='랄')then
oword(1:2)='날'
elseif(tword(5:6)=='릎')then
oword(1:2)='늪'
elseif(tword(5:6)=='람')then
oword(1:2)='남'
elseif(tword(5:6)=='랍')then
oword(1:2)='납'
elseif(tword(5:6)=='랑')then
oword(1:2)='낭'
elseif(tword(5:6)=='래')then
oword(1:2)='내'
elseif(tword(5:6)=='랭')then
oword(1:2)='냉'
elseif(tword(5:6)=='냑'.or.tword(5:6)=='략')then
oword(1:2)='약'
elseif(tword(5:6)=='량')then
oword(1:2)='양'
elseif(tword(5:6)=='녀'.or.tword(5:6)=='려')then
oword(1:2)='여'
elseif(tword(5:6)=='녁'.or.tword(5:6)=='력')then
oword(1:2)='역'
elseif(tword(5:6)=='년'.or.tword(5:6)=='련')then
oword(1:2)='연'
elseif(tword(5:6)=='녈'.or.tword(5:6)=='렬')then
oword(1:2)='열'
elseif(tword(5:6)=='념'.or.tword(5:6)=='렴')then
oword(1:2)='염'
elseif(tword(5:6)=='렵')then
oword(1:2)='엽'
elseif(tword(5:6)=='녕'.or.tword(5:6)=='령')then
oword(1:2)='영'
elseif(tword(5:6)=='례')then
oword(1:2)='예'
elseif(tword(5:6)=='로')then
oword(1:2)='노'
elseif(tword(5:6)=='록')then
oword(1:2)='녹'
elseif(tword(5:6)=='론')then
oword(1:2)='논'
elseif(tword(5:6)=='롱')then
oword(1:2)='농'
elseif(tword(5:6)=='뢰')then
oword(1:2)='뇌'
elseif(tword(5:6)=='뇨'.or.tword(5:6)=='료')then
oword(1:2)='요'
elseif(tword(5:6)=='룡'.or.tword(5:6)=='뇽')then
oword(1:2)='용'
elseif(tword(5:6)=='루')then
oword(1:2)='누'
elseif(tword(5:6)=='뉴'.or.tword(5:6)=='류')then
oword(1:2)='유'
elseif(tword(5:6)=='뉵'.or.tword(5:6)=='륙')then
oword(1:2)='육'
elseif(tword(5:6)=='륜')then
oword(1:2)='윤'
elseif(tword(5:6)=='률')then
oword(1:2)='율'
elseif(tword(5:6)=='륭')then
oword(1:2)='융'
elseif(tword(5:6)=='륵')then
oword(1:2)='늑'
elseif(tword(5:6)=='름')then
oword(1:2)='늠'
elseif(tword(5:6)=='릉')then
oword(1:2)='능'
elseif(tword(5:6)=='니'.or.tword(5:6)=='리')then
oword(1:2)='이'
elseif(tword(5:6)=='린')then
oword(1:2)='인'
elseif(tword(5:6)=='림')then
oword(1:2)='임'
elseif(tword(5:6)=='립')then
oword(1:2)='입'
elseif(tword(5:6)=='릅')then
oword(1:2)='늡'
elseif(tword(5:6)=='룹')then
oword(1:2)='눕'
elseif(tword(5:6)=='랏')then
oword(1:2)='낫'
elseif(tword(5:6)=='램')then
oword(1:2)='냄'
elseif(tword(5:6)=='룩')then
oword(1:2)='눅'
elseif(tword(5:6)=='릭')then
oword(1:2)='익'
elseif(tword(5:6)=='롬')then
oword(1:2)='놈'
elseif(tword(5:6)=='닝')then
oword(1:2)='잉'
elseif(tword(5:6)=='롭')then
oword(1:2)='놉'
elseif(tword(5:6)=='릇')then
oword(1:2)='늣'
elseif(tword(5:6)=='룻')then
oword(1:2)='눗'
elseif(tword(5:6)=='롄')then
oword(1:2)='옌'
elseif(tword(5:6)=='닉')then
oword(1:2)='익'
elseif(tword(5:6)=='렷')then
oword(1:2)='엿'
elseif(tword(5:6)=='닌')then
oword(1:2)='인'
elseif(tword(5:6)=='님'.or.tword(5:6)=='림')then
oword(1:2)='임'
else
oword(1:2)=''
endif
doword(i)=oword(1:2)
enddo !i
close(103)
close(104)
r1=10000
r2=10000
do i=asdasd,asdasd
do j=1,1000
totalcount=totalcount+1
write(*,*)s(1),s(2),s(3),s(4),s(5),'p1'
write(*,*)s(6),s(7),s(8),s(9),s(10),'p2'
write(*,*)j
do aa=1,100000
player1(aa)=''
player2(aa)=''
enddo
!!!!!!!!!!!!!!!!game start!!!!!!!!!!!!!
svalue=r(i,j)*c
if(svalue==0)then
svalue=c
endif
player1(1)=word(svalue)
p(1:80)=word(svalue)
turn=1
nturn(turn)=svalue
do ii=1,80
if(p(ii:ii)=='')then
pp(5:6)=p(ii-2:ii-1)
goto 13
endif
enddo
!!!!!!!!!!!!!!!!game start!!!!!!!!!!!!!
13 p1(1:2)=''
!!!!!!!!!!!!!!!!!!두음 set!!!!!!!!!!!!!
if(doword(svalue)/='')then
p1(1:2)=doword(svalue)
endif
!!!!!!!!!!!!!!!!!두음 set!!!!!!!!!!!!!!
dd=1
longing=1
yj=2
223 do k=yj,1000,1
longing=longing+1
acount=0
acount1=0
acount2=0
acount3=0
acount4=0
acount5=0
alreadycount=0
acountn(1)=0
acountn(2)=0
acountn(3)=0
acountn(4)=0
acountn(5)=0
do ii=1,c
!!!!!!!!!!두음법칙 예외!!!!!!!!!!
ow1(1:80)=word(ii)
ow2(1:80)=doword(ii)
!!!!!!!!!!두음법칙 예외!!!!!!!!!!
!!!!!!!!!!!!!!useable word scan!!!!!!!!!!!!!!!!!!
if(pp(5:6)==ow1(1:2).or.p1(1:2)==ow1(1:2))then
!!!!!!!!!!!!!!! already use word scan!!!!!!!!!!!!
do jj=1,turn
if(nturn(jj)==ii)then
alreadycount=alreadycount+1
goto 3
endif
enddo
!!!!!!!!!!!!!!! already use word scan!!!!!!!!!!!!
acount=acount+1
saveword(acount)=word(ii)
savenum(acount)=ii
endif
!!!!!!!!!!!!!!useable word scan!!!!!!!!!!!!!!!!!!
!!!!!!!!!!!!!!!!!go game!!!!!!!!!!!!!!!!!!!!!!!
if(ii==c.and.acount>=1.and.totalcount==0)then
gvalue=acount*r(i+k,j+k)
if(gvalue==0)then
gvalue=acount
endif
player2count(longing)=acount
player2(longing)=saveword(gvalue)
p(1:80)=player2(longing)
do kkk=1,80
if(p(kkk:kkk)=='')then
pp(5:6)=p(kkk-2:kkk-1)
goto 14
endif
enddo
14 turn=turn+1
dd=dd+1 !test
do kkk=1,c
if(player2(longing)==word(kkk))then
nturn(turn)=kkk
nt1=nturn(turn)
endif
enddo
endif
!!!!!!!!!!!!!!!go game!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!!!!!!!!!!!!!!!!go game!!!!!!!!!!!!!!!!!!!!!!!
if(ii==c.and.acount>=1.and.totalcount>=1)then
acounta=0
do jj=20000,-10000,-1
do kk=1,acount,1
snum=savenum(kk)
if(jj==20000.and.(score2(snum)>jj))then
acounta=acounta+1
saveword(acounta)=word(snum)
endif
if(jj/=20000.or.jj/=-10000)then
if((score2(snum)==jj))then
acounta=acounta+1
saveword(acounta)=word(snum)
endif
endif
if(jj==-10000.and.(score2(snum)<=jj))then
acounta=acount+1
saveword(acounta)=word(snum)
endif
enddo
if(acounta>=1)then
p2acount(longing)=jj
goto 1000
endif
enddo
1000 gvalue=acounta*r(i+k,j+k)
if(gvalue==0)then
gvalue=acounta
endif
player2count(longing)=acount
player2(longing)=saveword(gvalue)
p(1:80)=player2(longing)
do kkk=1,80
if(p(kkk:kkk)=='')then
pp(5:6)=p(kkk-2:kkk-1)
goto 15
endif
enddo
15 turn=turn+1
dd=dd+1 !test
do kkk=1,c
if(player2(longing)==word(kkk))then
nturn(turn)=kkk
nt1=nturn(turn)
endif
enddo
endif
!!!!!!!!!!!!!!!go game!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!!!!!!!!!!!!!!!stop game!!!!!!!!!!!!!!!!!!!!!!!!
if(ii==c.and.acount==0)then
think1=0
think2=think2+1
write(*,*)'player2 lost',longing,think2
s(1)=0
s(2)=0
s(3)=0
s(4)=0
s(5)=0
s(6)=0
s(7)=0
s(8)=0
s(9)=0
s(10)=0
do ki=1,longing
do kj=1,c
if(player1(ki)==word(kj))then
score1(kj)=score1(kj)+1
totalgame1(kj)=totalgame1(kj)+1
wingame1(kj)=wingame1(kj)+1
if(totalgame1(kj)>=1)then
winper1(kj)=wingame1(kj)/totalgame1(kj)
endif
endif
if(player2(ki)==word(kj))then
score2(kj)=score2(kj)-1
totalgame2(kj)=totalgame2(kj)+1
lostgame2(kj)=lostgame2(kj)+1
if(totalgame2(kj)>=1)then
winper2(kj)=wingame2(kj)/totalgame2(kj)
endif
endif
enddo
enddo
winword(1:80)=player1(longing-1)
lostword(1:80)=player2(longing-1)
do ki=1,80
if(winword(ki:ki)=='')then
winword1(1:2)=winword(ki-2:ki-1)
goto 814
endif
enddo
814 do ki=1,80
if(lostword(ki:ki)=='')then
lostword1(1:2)=lostword(ki-2:ki-1)
goto 815
endif
enddo
815 do ki=1,c
if((winword(1:2)/=winword1(1:2)).and.(winword1(1:2)==word_end(ki)))then
score1(ki)=score1(ki)+2
endif
if((winword(1:2)==winword1(1:2)).and.(winword1(1:2)==word_end(ki)))then
write(*,*)word(ki),'점수계산 열외'
endif
if(lostword1(1:2)==word_end(ki))then
score2(ki)=score2(ki)-2
endif
if(winword(1:80)==word(ki))then
score1(ki)=score1(ki)+5
endif
if(lostword(1:80)==word(ki))then
score2(ki)=score2(ki)-5
endif
enddo
jerry=0
do kk=1,100,1
if(p2acount(longing-kk)<=-10)then
jerry=jerry+1
if(jerry/=kk)then
goto 888
endif
winword(1:80)=player1(longing-(kk+1))
lostword(1:80)=player2(longing-(kk+1))
write(*,*)lostword(1:80),'p2',kk,'공격당함'
write(*,*)winword(1:80),'p1',kk,'공격함'
do ki=1,80
if(lostword(ki:ki)=='')then
lostword1(1:2)=lostword(ki-2:ki-1)
goto 816
endif
enddo
816 do ki=1,80
if(winword(ki:ki)=='')then
winword1(1:2)=winword(ki-2:ki-1)
goto 817
endif
enddo
817 do ki=1,c
if(lostword1(1:2)==word_end(ki))then
score2(ki)=score2(ki)-2
endif
if(lostword(1:80)==word(ki))then
score2(ki)=score2(ki)-5
endif
if((winword1(1:2)==word_end(ki)).and.(winword(1:2)/=winword1(1:2)))then
score1(ki)=score1(ki)+2
endif
if((winword1(1:2)==word_end(ki)).and.(winword(1:2)==winword1(1:2)))then
write(*,*)word(ki),'점수계산 열외'
endif
if(winword(1:80)==word(ki))then
score1(ki)=score1(ki)+5
endif
enddo
endif
enddo
888 if(mod(j,100)==0)then
open(301,file='./a/p1/1s.txt',action='write')
open(302,file='./a/p1/2s.txt',action='write')
open(303,file='./a/p1/3s.txt',action='write')
open(304,file='./a/p1/4s.txt',action='write')
open(305,file='./a/p1/5s.txt',action='write')
do kki=1,c
if((winper1(kki)>=0.0.and.winper1(kki)<0.2))then
write(301,'(a80,1x,4f10.3,2i10)')word(kki),totalgame1(kki),wingame1(kki),lostgame1(kki),winper1(kki),score1(kki),kki
s(1)=s(1)+1
elseif((winper1(kki)>=0.2.and.winper1(kki)<0.4))then
write(302,'(a80,1x,4f10.3,2i10)')word(kki),totalgame1(kki),wingame1(kki),lostgame1(kki),winper1(kki),score1(kki),kki
s(2)=s(2)+1
elseif((winper1(kki)>=0.4.and.winper1(kki)<0.6))then
write(303,'(a80,1x,4f10.3,2i10)')word(kki),totalgame1(kki),wingame1(kki),lostgame1(kki),winper1(kki),score1(kki),kki
s(3)=s(3)+1
elseif((winper1(kki)>=0.6.and.winper1(kki)<0.8))then
write(304,'(a80,1x,4f10.3,2i10)')word(kki),totalgame1(kki),wingame1(kki),lostgame1(kki),winper1(kki),score1(kki),kki
s(4)=s(4)+1
elseif((winper1(kki)>=0.8))then
write(305,'(a80,1x,4f10.3,2i10)')word(kki),totalgame1(kki),wingame1(kki),lostgame1(kki),winper1(kki),score1(kki),kki
s(5)=s(5)+1
endif
enddo
close(301)
close(302)
close(303)
close(304)
close(305)
open(306,file='./a/p2/1s.txt',action='write')
open(307,file='./a/p2/2s.txt',action='write')
open(308,file='./a/p2/3s.txt',action='write')
open(309,file='./a/p2/4s.txt',action='write')
open(310,file='./a/p2/5s.txt',action='write')
do kki=1,c
if((winper2(kki)>=0.0.and.winper2(kki)<0.2))then
write(306,'(a80,1x,4f10.3,2i10)')word(kki),totalgame2(kki),wingame2(kki),lostgame2(kki),winper2(kki),score2(kki),kki
s(6)=s(6)+1
elseif((winper2(kki)>=0.2.and.winper2(kki)<0.4))then
write(307,'(a80,1x,4f10.3,2i10)')word(kki),totalgame2(kki),wingame2(kki),lostgame2(kki),winper2(kki),score2(kki),kki
s(7)=s(7)+1
elseif((winper2(kki)>=0.4.and.winper2(kki)<0.6))then
write(308,'(a80,1x,4f10.3,2i10)')word(kki),totalgame2(kki),wingame2(kki),lostgame2(kki),winper2(kki),score2(kki),kki
s(8)=s(8)+1
elseif((winper2(kki)>=0.6.and.winper2(kki)<0.8))then
write(309,'(a80,1x,4f10.3,2i10)')word(kki),totalgame2(kki),wingame2(kki),lostgame2(kki),winper2(kki),score2(kki),kki
s(9)=s(9)+1
elseif((winper2(kki)>=0.8))then
write(310,'(a80,1x,4f10.3,2i10)')word(kki),totalgame2(kki),wingame2(kki),lostgame2(kki),winper2(kki),score2(kki),kki
s(10)=s(10)+1
endif
enddo
close(306)
close(307)
close(308)
close(309)
close(310)
endif
open(201,file='./a/p1/tt_1win.txt')
do ki=2,longing
write(201,*)player2(ki),ki,'player2'
write(201,*)player1(ki),ki,'player1'
enddo
close(201)
goto 222
endif
!!!!!!!!!!!!!!!!stop game!!!!!!!!!!!!!!!!!!!!!!!!
3 enddo !ii
do kk=1,c
saveword(kk)=''
saveword1(kk)=''
saveword2(kk)=''
saveword3(kk)=''
saveword4(kk)=''
saveword5(kk)=''
savenum(kk)=0
savenum1(kk)=0
savenum2(kk)=0
savenum3(kk)=0
savenum4(kk)=0
savenum5(kk)=0
enddo
acount=0
alreadycount=0
acount=0
acount1=0
acount2=0
acount3=0
acount4=0
acount5=0
alreadycount=0
acountn(1)=0
acountn(2)=0
acountn(3)=0
acountn(4)=0
acountn(5)=0
p1(1:2)=''
if(doword(nt1)/='')then
p1(1:2)=doword(nt1)
! write(*,*)doword(nt1)
endif
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
do ii=1,c
!!!!!!!!!!두음법칙 예외!!!!!!!!!!
ow1(1:80)=word(ii)
ow2(1:80)=doword(ii)
!!!!!!!!!!두음법칙 예외!!!!!!!!!!
!!!!!!!!!!!!!!useable word scan!!!!!!!!!!!!!!!!!!
if(pp(5:6)==ow1(1:2).or.p1(1:2)==ow1(1:2))then
!!!!!!!!!!!!!!! already use word scan!!!!!!!!!!!!
do jj=1,turn
if(nturn(jj)==ii)then
alreadycount=alreadycount+1
goto 4
endif
enddo
!!!!!!!!!!!!!!! already use word scan!!!!!!!!!!!!
acount=acount+1
saveword(acount)=word(ii)
savenum(acount)=ii
endif
!!!!!!!!!!!!!!useable word scan!!!!!!!!!!!!!!!!!!
!!!!!!!!!!!!!!!!!go game!!!!!!!!!!!!!!!!!!!!!!!
if(ii==c.and.acount>=1.and.totalcount==0)then
gvalue=acount*r(i+k,j+k)
if(gvalue==0)then
gvalue=acount
endif
player1count(longing)=acount
player1(longing)=saveword(gvalue)
p(1:80)=player1(longing)
do kkk=1,80
if(p(kkk:kkk)=='')then
pp(5:6)=p(kkk-2:kkk-1)
goto 17
endif
enddo
17 turn=turn+1
dd=dd+1 !test
do kkk=1,c
if(player1(longing)==word(kkk))then
nturn(turn)=kkk
nt1=nturn(turn)
endif
enddo
endif
!!!!!!!!!!!!!!!go game!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!!!!!!!!!!!!!!!!go game!!!!!!!!!!!!!!!!!!!!!!!
if(ii==c.and.acount>=1.and.totalcount>=1)then
acounta=0
do jj=20000,-10000,-1
do kk=1,acount,1
snum=savenum(kk)
if(jj==20000.and.(score1(snum)>jj))then
acounta=acounta+1
saveword(acounta)=word(snum)
endif
if(jj/=20000.or.jj/=-10000)then
if(score1(snum)==jj)then
acounta=acounta+1
saveword(acounta)=word(snum)
endif
endif
if(jj==-10000.and.(score1(snum)
=1)then
p1acount(longing)=jj
goto 1001
endif
enddo
1001 gvalue=acounta*r(i+k,j+k)
if(gvalue==0)then
gvalue=acounta
endif
player1count(longing)=acount
player1(longing)=saveword(gvalue)
p(1:80)=player1(longing)
do kkk=1,80
if(p(kkk:kkk)=='')then
pp(5:6)=p(kkk-2:kkk-1)
goto 18
endif
enddo
18 turn=turn+1
dd=dd+1 !test
do kkk=1,c
if(player1(longing)==word(kkk))then
nturn(turn)=kkk
nt1=nturn(turn)
endif
enddo
endif
!!!!!!!!!!!!!!!go game!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!!!!!!!!!!!!!!!stop game!!!!!!!!!!!!!!!!!!!!!!!!
if(ii==c.and.acount==0)then
think1=think1+1
think2=0
write(*,*)'player1 lost',think1,longing
s(1)=0
s(2)=0
s(3)=0
s(4)=0
s(5)=0
s(6)=0
s(7)=0
s(8)=0
s(9)=0
s(10)=0
do ki=1,longing
do kj=1,c
if(player1(ki)==word(kj))then
score1(kj)=score1(kj)-1
totalgame1(kj)=totalgame1(kj)+1
lostgame1(kj)=lostgame1(kj)+1
if(totalgame1(kj)>=1)then
winper1(kj)=wingame1(kj)/totalgame1(kj)
endif
endif
if(player2(ki)==word(kj))then
score2(kj)=score2(kj)+1
totalgame2(kj)=totalgame2(kj)+1
wingame2(kj)=wingame2(kj)+1
if(totalgame2(kj)>=1)then
winper2(kj)=wingame2(kj)/totalgame2(kj)
endif
endif
enddo
enddo
winword(1:80)=player2(longing)
lostword(1:80)=player1(longing-1)
do ki=1,80
if(winword(ki:ki)=='')then
winword1(1:2)=winword(ki-2:ki-1)
goto 916
endif
enddo
916 do ki=1,80
if(lostword(ki:ki)=='')then
lostword1(1:2)=lostword(ki-2:ki-1)
goto 917
endif
enddo
917 do ki=1,c
if((winword1(1:2)==word_end(ki)).and.(winword(1:2)/=winword1(1:2)))then
score2(ki)=score2(ki)+2
endif
if((winword(1:2)==winword1(1:2)).and.(winword1(1:2)==word_end(ki)))then
write(*,*)word(ki),'점수계산 열외'
endif
if(lostword1(1:2)==word_end(ki))then
score1(ki)=score1(ki)-2
endif
if(winword(1:80)==word(ki))then
score2(ki)=score2(ki)+5
endif
if(lostword(1:80)==word(ki))then
score1(ki)=score1(ki)-5
endif
enddo
jerry=0
do kk=1,100,1
if(p1acount(longing-kk)<=-10)then
jerry=jerry+1
if(jerry/=kk)then
goto 889
endif
winword(1:80)=player2(longing-kk)
lostword(1:80)=player1(longing-(kk+1))
write(*,*)lostword(1:80),'p1',kk,'공격당함'
write(*,*)winword(1:80),'p2',kk,'공격함'
do ki=1,80
if(lostword(ki:ki)=='')then
lostword1(1:2)=lostword(ki-2:ki-1)
goto 918
endif
enddo
918 do ki=1,80
if(winword(ki:ki)=='')then
winword1(1:2)=winword(ki-2:ki-1)
goto 919
endif
enddo
919 do ki=1,c
if(lostword1(1:2)==word_end(ki))then
score1(ki)=score1(ki)-2
endif
if(lostword(1:80)==word(ki))then
score1(ki)=score1(ki)-5
endif
if(winword1(1:2)==word_end(ki).and.(winword(1:2)/=winword1(1:2)))then
score2(ki)=score2(ki)+2
endif
if((winword(1:2)==winword1(1:2)).and.(winword1(1:2)==word_end(ki)))then
write(*,*)word(ki),'점수계산 열외'
endif
if(winword(1:80)==word(ki))then
score2(ki)=score2(ki)+5
endif
enddo
endif
enddo
889 if(mod(j,100)==0)then
open(301,file='./a/p1/1s.txt',action='write')
open(302,file='./a/p1/2s.txt',action='write')
open(303,file='./a/p1/3s.txt',action='write')
open(304,file='./a/p1/4s.txt',action='write')
open(305,file='./a/p1/5s.txt',action='write')
do kki=1,c
if((winper1(kki)>=0.0.and.winper1(kki)<0.2))then
write(301,'(a80,1x,4f10.3,2i10)')word(kki),totalgame1(kki),wingame1(kki),lostgame1(kki),winper1(kki),score1(kki),kki
s(1)=s(1)+1
elseif((winper1(kki)>=0.2.and.winper1(kki)<0.4))then
write(302,'(a80,1x,4f10.3,2i10)')word(kki),totalgame1(kki),wingame1(kki),lostgame1(kki),winper1(kki),score1(kki),kki
s(2)=s(2)+1
elseif((winper1(kki)>=0.4.and.winper1(kki)<0.6))then
write(303,'(a80,1x,4f10.3,2i10)')word(kki),totalgame1(kki),wingame1(kki),lostgame1(kki),winper1(kki),score1(kki),kki
s(3)=s(3)+1
elseif((winper1(kki)>=0.6.and.winper1(kki)<0.8))then
write(304,'(a80,1x,4f10.3,2i10)')word(kki),totalgame1(kki),wingame1(kki),lostgame1(kki),winper1(kki),score1(kki),kki
s(4)=s(4)+1
elseif((winper1(kki)>=0.8))then
write(305,'(a80,1x,4f10.3,2i10)')word(kki),totalgame1(kki),wingame1(kki),lostgame1(kki),winper1(kki),score1(kki),kki
s(5)=s(5)+1
endif
enddo
close(301)
close(302)
close(303)
close(304)
close(305)
open(306,file='./a/p2/1s.txt',action='write')
open(307,file='./a/p2/2s.txt',action='write')
open(308,file='./a/p2/3s.txt',action='write')
open(309,file='./a/p2/4s.txt',action='write')
open(310,file='./a/p2/5s.txt',action='write')
do kki=1,c
if((winper2(kki)>=0.0.and.winper2(kki)<0.2))then
write(306,'(a80,1x,4f10.3,2i10)')word(kki),totalgame2(kki),wingame2(kki),lostgame2(kki),winper2(kki),score2(kki),kki
s(6)=s(6)+1
elseif((winper2(kki)>=0.2.and.winper2(kki)<0.4))then
write(307,'(a80,1x,4f10.3,2i10)')word(kki),totalgame2(kki),wingame2(kki),lostgame2(kki),winper2(kki),score2(kki),kki
s(7)=s(7)+1
elseif((winper2(kki)>=0.4.and.winper2(kki)<0.6))then
write(308,'(a80,1x,4f10.3,2i10)')word(kki),totalgame2(kki),wingame2(kki),lostgame2(kki),winper2(kki),score2(kki),kki
s(8)=s(8)+1
elseif((winper2(kki)>=0.6.and.winper2(kki)<0.8))then
write(309,'(a80,1x,4f10.3,2i10)')word(kki),totalgame2(kki),wingame2(kki),lostgame2(kki),winper2(kki),score2(kki),kki
s(9)=s(9)+1
elseif((winper2(kki)>=0.8))then
write(310,'(a80,1x,4f10.3,2i10)')word(kki),totalgame2(kki),wingame2(kki),lostgame2(kki),winper2(kki),score2(kki),kki
s(10)=s(10)+1
endif
enddo
close(306)
close(307)
close(308)
close(309)
close(310)
endif
open(201,file='./a/p2/tt_2win.txt')
do ki=2,longing
write(201,*)player2(ki),ki,'player2'
write(201,*)player1(ki),ki,'player1'
enddo
close(201)
goto 222
endif
!!!!!!!!!!!!!!!!stop game!!!!!!!!!!!!!!!!!!!!!!!!
4 enddo !ii
p1(1:2)=''
if(doword(nt1)/='')then
p1(1:2)=doword(nt1)
endif
do kk=1,c
saveword(kk)=''
saveword1(kk)=''
saveword2(kk)=''
saveword3(kk)=''
saveword4(kk)=''
saveword5(kk)=''
savenum(kk)=0
savenum1(kk)=0
savenum2(kk)=0
savenum3(kk)=0
savenum4(kk)=0
savenum5(kk)=0
enddo
acount=0
alreadycount=0
acount=0
acount1=0
acount2=0
acount3=0
acount4=0
acount5=0
alreadycount=0
acountn(1)=0
acountn(2)=0
acountn(3)=0
acountn(4)=0
acountn(5)=0
enddo !k
! do ki=1,999
! write(*,*)player1(longing-ki),player2(longing-ki),ki
! enddo
! yj=990
! goto 223
222 enddo !j
enddo !i
open(778,file='./b/saveplayer11.txt',action='write')
open(779,file='./b/saveplayer22.txt',action='write')
do i=1,c
write(778,'(a80,1x,4f10.3,2i10)')word(i),totalgame1(i),wingame1(i),lostgame1(i),winper1(i),score1(i),i
write(779,'(a80,1x,4f10.3,2i10)')word(i),totalgame2(i),wingame2(i),lostgame2(i),winper2(i),score2(i),i
enddo
close(778)
close(779)
end
참고 문헌
[논문]
- 없음
[보고서]
- 없음
[URL]
- 없음
문의사항
[기상학/프로그래밍 언어]
- sangho.lee.1990@gmail.com
[해양학/천문학/빅데이터]
- saimang0804@gmail.com
'프로그래밍 언어 > Fortran' 카테고리의 다른 글
| [Fortran] 포트란 퇴각검색을 이용한 스도쿠 풀이 알고리즘 (0) | 2019.09.05 |
|---|---|
| [Fortran, Gnuplot, ShellScript] 기상 자료를 이용한 통계 분석 및 가시화 (0) | 2019.09.01 |
| [Fortran] 포트란 지상 관측소를 기준으로 근접한 1/4/9 위성 픽셀에 대해 평균 수행 (0) | 2019.08.25 |
| [Fortran] 포트란 Arrey Function 예제 (0) | 2019.07.26 |
| [Fortran] 포트란 Himawari-8/AHI (2 km)을 CERES (20 km)로 공간 해상도 일치 (0) | 2019.07.25 |
최근댓글