ラテン方格での順列作成

このQ&Aのポイント
  • fortranでラテン方格を作るプログラムを作っていますが、縦方向で同じ数字を繰り返してしまいます。
  • 現時点でのプログラムをプログラムは以下のとおりです。最終的には100×100ぐらいを作りたいと思っています。
  • 参考にしたい結果は、縦方向に同じ数字を繰り返すことなく順列を作成することです。
回答を見る
  • ベストアンサー

ラテン方格での順列作成

fortranでラテン方格を作るプログラムを作っていますが、 4 3 2 1 1 2 3 4 2 1 3 4 1 4 2 3 と縦方向で同じ数字を繰り返してしまいます。必要なのは 4 3 2 1 1 2 3 4 2 1 4 3 3 4 1 2 です。参考に現時点でのプログラムをプログラムは以下のとおりです。最終的には100×100ぐらいを作りたいと思っています。 INTEGER :: K INTEGER, DIMENSION(4) ::T READ (*,*) N DO 500 NN=1,N T(NN)=NN 500 CONTINUE write (*,'(1X,5I3)') T OPEN(UNIT=9,FILE='outmt') DO 505 NTB=1,4 DO 504 I=1,N S=rand() K=(S*I)+1 TMP = T(K) T(K) = T(I) T(I) = TMP 504 CONTINUE write (9,'(1X,4I3)') T 505 CONTINUE END

質問者が選んだベストアンサー

  • ベストアンサー
  • jjon-com
  • ベストアンサー率61% (1599/2592)
回答No.2

ANo.1の指摘どおり,縦方向にすでに登場している数字かどうかを判定する必要がありますから,1次元配列ではなく2次元配列を用いることになるでしょう。 しかし,乱数を使って数字を1つ当てはめた後それが規則に合っているか検査していく,なんて複雑ですよ。ja.Wikipediaによると, ラテン方格は、第1行および第1列が自然な順序で並んでいる場合に標準形という。 どんなラテン方格も行、または列を交換することで標準形にできる。 http://ja.wikipedia.org/wiki/ラテン方格 ということですから, 規則正しい標準形のラテン方陣をまず作っておいて,あとは乱数で行・列を決めて好きな回数だけ交換するのが良いのではないですか。全面全色そろったルービックキューブを先に用意しておき,好きな回数だけ行・列をランダムに崩していくイメージです。 FORTRANの実効環境が手元にないので,ある別のプログラム言語で,4×4の2次元配列中に規則正しい標準形のラテン方陣を作り出すコードを書いてみました。コード中の % は剰余演算子です。 ---------------------------------------- $n = 4; foreach $i (1..4) {  $nn = $i;  foreach $j (1..4) {   $t[$i][$j] = $nn;   $nn = ($nn % $n) + 1;  } } foreach $i (1..4) {  foreach $j (1..4) {   print $t[$i][$j], " ";  }  print "\n"; } ---------------------------------------- これがどんなプログラム言語か知らなくても,アルゴリズムのイメージはつかめるのではないでしょうか。これを実行すると次のように出力されます。 ------------ 1 2 3 4 2 3 4 1 3 4 1 2 4 1 2 3 ------------

yasuu2005
質問者

お礼

ご回答ありがとうございます。 ご指摘のとおり1行目に標準型を一度作ってそこからランダムにして、縦方向は1行ずれる毎に1列ずらすということで縦方向の重複がないようにすることとしました。 具体的なプログラムまで書いていただきありがとうございました。 大変参考になりました。

その他の回答 (1)

  • asuncion
  • ベストアンサー率33% (2126/6288)
回答No.1

> 縦方向で同じ数字を繰り返してしまいます。 縦方向にすでに登場しているかどうかの判定をしないまま、 無条件に配列要素を入れ替えているところに問題があると思います。

yasuu2005
質問者

お礼

ご回答ありがとうございます。 ご指摘のとおり縦方向の判定をしておりませんでした。 判定をしないでよい仕組みを考えます。

関連するQ&A

  • FORTRAN→Cに翻訳

     どなたか、次のFORTRANのプログラムを、Cに、翻訳して頂けないでしょうか。C++ではなく、Cです。ANSI準拠のCでお願いします。  プログラムの内容は、最小二乗法による計算プログラムです。MS-DOS Ver3.3~6.0の頃の、MS FORTRANコンパイラ仕様のものです。その頃持っていたFORTRANの本も処分してしまい、今からFORTRANを学びなおすのにも多大な労力と時間がかかりそうなので、Cに翻訳して頂ければ大変ありがたいです。よろしくお願いします。 (“□”はタブ) ◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆ C□LEAST SQUARE APPROXIMATION □PROGRAM MAIN9 □DIMENSION X(100),Y(100),S(0:18),T(0:9),SM(10,10),TV(10),AV(10) □WRITE(*,*) 'N ?' □READ(*,*) N □WRITE(*,*) 'x1,x2,..,xn ?' □READ(*,*) ( X(I),I=1,N ) □WRITE(*,*) 'y1,y2,..,yn ?' □READ(*,*) ( Y(I),I=1,N ) □WRITE(*,*) 'M ?' □READ(*,*) M □DO 110 K=0,M*2 □□VS=0. □□DO 100 I=1,N □100□VS=VS+X(I)**K □□S(K)=VS □110□CONTINUE □□DO 130 K=0,M □□□VS=0. □□□DO 120 I=1,N □120□VS=VS+Y(I)*X(I)**K □□□T(K)=VS □130 CONTINUE □□DO 140 I=1,M+1 □□□DO 140 J=1,M+1 □□□□K=I+J-2 □□□□SM(I,J)=S(K) □140 CONTINUE □□DO 150 I=1,M+1 □150 TV(I)=T(I-1) □□CALL SIMULE( AV, SM, TV, M+1 ) □□DO 160 I=1,M+1 □160 WRITE(*,1000) I-1,AV(I) □1000 FORMAT(1H ,'A',I1,'=',F10.5) □□STOP □□END ◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆

  • Fortran90のプログラムについて

    大学で卒論のためにFortran90でランダムウォークのプログラムを作ってるんですが…2週間悩んでるんですが、できないところがあります。 「1次元のランダムウォークにおいて、ステップ数Nとxの値を与えたときのすべての可能な歩行を数え上げるプログラムを書け」というものです。 直接ステップ数を書き込んだプログラムを基にして任意のステップ数を入力するプログラムを作ってみたんですが、うまくいきません。 integer :: a(100,20), x, i1, i2, i3 x = 0 do i1 = -1, 1, 2;do i2 = -1, 1, 2;do i3 = -1, 1, 2 x = x + 1 a(x, 1) = i1;a(x, 2) = i2;a(x, 3) = i3 end do;end do;end do end が基にしたプログラムです。これはステップ数が'3'なので実行結果は「-1-1-1,-1-11,-11-1,-11-1,-111,1-1-1,11-1,111」というxの変位の仕方が出ます。 integer, allocatable :: a(:,:) integer :: i, n, x, l print *, 'ステップ数を入力:'; read *, n allocate(a(n, 2**n)) do l = 1, n do i = -1, 1, 2 x = x + 1 a(x, l) = i end do end do end という風に作ってみたんですが、'3'を入力しても同じ結果が出ません。わかりにくい文章で申し訳ないですがどなたかご教授お願いします。

  • FORTRAN 初心者です

    以下の連立一次方程式をSOR法で解く問題です。 初心者なりにガウスザイデル法を応用してプログラムしたつもりですが、やはり難しいです(答えは違います)。 どこをどうすれば良いのか分かりませんので、よろしければヒントや助言をいただきたいです。 PROGRAM SOR REAL A(10,10),B(10),X(10),X0(10) INTEGER N,I,J,K,Kmax,w N=3 A(1,1)=4 ;A(1,2)=1 ;A(1,3)=2 A(2,1)=1 ;A(2,2)=3 ;A(2,3)=1 A(3,1)=1 ;A(3,2)=2 ;A(3,3)=5 B(1)=16 B(2)=10 B(3)=12 X0(1)=1 ;X0(2)=1 ;X0(3)=2 w=1.2 Kmax=50 EPS=1.D-5 DO I=1,N D=A(I,I) S=B(I) B(I)=B(I)/D END DO DO K=1,Kmax DO I=1,N DO J=1,N if(J<I) X0(J)=X(J) S=S-A(I,J)*X0(J) END DO X(I)=(1-w)*X(I)+w*S END DO DO I=1,N S=S-(X(I)-X0(I))**2 END DO IF(S<EPS) GOTO 10 DO I=1,N X0(I)=X(I) END DO END DO 10 WRITE(*,*) K DO I=1,N WRITE(*,*) 'SOR法で求めた解は' WRITE(*,*) 'X(',I,')=',X(I) END DO END PROGRAM SOR !------------------------------------ ※wは緩和係数です

  • fortran 行列ベクトル積

    行列ベクトル積を計算するプログラムを下のように書いたのですが、実行した結果の答えが実際計算した答えと異なります。初期の要素の設定がおかしいのでしょうか?教えて下さい。よろしくお願いします。 program list2_14 implicit none integer , parameter :: n = 2 real(8) a(n,n), x(n), y(n) integer i, j, k, l a(1,1:2) = (/1.2d0,3.4d0/) a(2,1:2) = (/5.6d0,7.8d0/) x(:) = (/9.0d0,10.0d0/) do i = 1, n y(i) = 0.0d0 do j = 1, n y(i) = y(i) + a(i,j) * x(j) enddo enddo do k = 1, n write(*,*) (a(k,l), l = 1, n) enddo write(*,*) x(:) write(*,*) y(n) end program list2_14 実行結果 1.2 3.4 5.6 7.8 9. 10. 128.4

  • fortaran初心者です...(複数条件の一致のカウント)

    はじめまして。 初歩的な質問でごめんさい。 今次のようなデータがあります。   (1)   (2) 1156605004 11514 1156605004 01543 1157605004 11514 1121405601 01111 1121405601 04184 これより出力を(1)が同じものの中にいくつ違う(2)があるのかカウントしたいのですがなぜだか出来ません。誰か教えてもらえないでしょうか? 出力はこのようにしたいのです。 1157605004 02 1121405601 02 としたいのです。 ちなみに私が作ったプログラムは、 INTEGER i,j,k,ii,jj PARAMETER (numdis=9000000,namer=20) INTEGER DAT1,DAT2,DAT3 DIMENSION NKOTU(numdis,namer),NUMR(numdis) do 2 i=1,numdis NUMR(i)=0 do 1 j=1,namer NKOTU(i,j)=0 1 CONTINUE 2 CONTINUE 14 READ(11,5001,END=15) DAT1,DAT2,DAT3 5001 FORMAT(I10,1X,I5,1X,I2) NKOTU(DAT1,DAT3)= 1 GOTO 14 15 CONTINUE do 3 ii=100000,numdis do 4 k=1,namer If (NKOTU(ii,k).EQ.1) NUMR(ii)=NUMR(ii)+1 If (NKOTU(ii,k).EQ.1) WRITE(21,6004) NUMR(ii),KOTU(ii,k) 4 CONTINUE 3 CONTINUE do 5 jj=100000,numdis If (NUMR(jj).GE.1) WRITE(21,6004) jj, NUMR(jj) 5 CONTINUE 6004 FORMAT(I10,1X,I5) STOP END 配列が大きすぎるのでしょうか? こんな初歩的な質問で申し訳ないのですが 誰か教えてください、よろしくお願いします。

  • 順列・数え上げ

    よろしくお願いします。 ここに下のような390個の文字があります。 (A,B,C,D,E,F,G,H,I,J,K,L,M がそれぞれ10個ずつ、 N,O,P,Q,R,S,T,U,V,W,X,Y,Z がそれぞれ20個ずつあります。) この390個の文字から235文字を選んで一列に並べる方法は全部で何通りありますか。 A B C D E F G H I J K L M A B C D E F G H I J K L M A B C D E F G H I J K L M A B C D E F G H I J K L M A B C D E F G H I J K L M A B C D E F G H I J K L M A B C D E F G H I J K L M A B C D E F G H I J K L M A B C D E F G H I J K L M A B C D E F G H I J K L M N O P Q R S T U V W X Y Z N O P Q R S T U V W X Y Z N O P Q R S T U V W X Y Z N O P Q R S T U V W X Y Z N O P Q R S T U V W X Y Z N O P Q R S T U V W X Y Z N O P Q R S T U V W X Y Z N O P Q R S T U V W X Y Z N O P Q R S T U V W X Y Z N O P Q R S T U V W X Y Z N O P Q R S T U V W X Y Z N O P Q R S T U V W X Y Z N O P Q R S T U V W X Y Z N O P Q R S T U V W X Y Z N O P Q R S T U V W X Y Z N O P Q R S T U V W X Y Z N O P Q R S T U V W X Y Z N O P Q R S T U V W X Y Z N O P Q R S T U V W X Y Z N O P Q R S T U V W X Y Z 以下、私が考えたことを書きます。 この390個の文字から235個の文字を選ぶ組み合わせの総数は、 (Σ[k=0~10]x^k)^13*(Σ[k=0~20]x^k)^13 を展開したときのx^235の係数ですから、 23463540513956137996043929988 通りだということは分かります。 この23463540513956137996043929988 通りのそれぞれについて235個の文字 の順列(同種のものを含む順列)を数え上げれば答えは出ると思いますが、これは あまりにも大変な作業です。 何かよい知恵はないでしょうか。

  • ガウスの消去

    ガウスの消去法のプログラムを作ったのですがうまく動きません どこが間違っているのでしょう ちなみに連立方程式を解くプログラムです * the numerical solution of linear equation * by gauss method parameter(ll=10) dimension a(ll,ll+1), x(ll) read(5,100) n 100 format(i3) do 150 i = 1, n 150 read(5,200) (a(i,j), j=1, n+1) 200 format(11f4.1) write(6,300) 300 format(' ', 10x, 'coefficient') do 10 i = 1, n write(6,400) (a(i,j), j=1, n+1) 400 format(' ', 11 (5x, f4.1)) 10 continue esp=10.0e-19 call rgaule(a, x, ll, n, esp, ipivot) if (ipivot. eq. 1) go to 20 write(6,500) 500 format(' ', 10x, 'the pivot is little '/ 1 'so the solution is singular') go to 110 20 write(6,600) 600 format(/' ',2x, 8hsolution) write (6,700) (i, x(i), i = 1, n) 700 format (' ',5x, 'x (', i2, ' ) =', 2x, e14.7) 110 stop end subroutine rgaule(a, x, ll, n, esp, ipivot) dimension a(ll, ll+1), x(ll), ln(100) ipivot = 1 * the order of x do 5 i = 1, n ln(i) = i 5 continue do 100 m = 1, n-1 * the selection of pivot amax = 0.0 do 10 i = m, n do 20 j = m, n if (amax. ge. abs(a(i,j))) go to 20 amax = abs(a(i, j)) irow = i icolum = j 20 continue 10 continue if (amax. le. eps) go to 70 if (m. eq. irow) go to 22 * the exchange of row do 27 l = m, n+1 swap = a(irow, l) a(irow, l) = a(m, l) a(m, l) = swap 27 continue 22 if (m. eq. icolum) go to 30 * the exchange of colum do 25 l =1, n swap = a(l, icolum) a(l, icolum) = a(l,m) a(l, m) = swap 25 continue * the exchange of x iswap = ln(m) ln(m) = ln(icolum) ln(icolum) = iswap * gaussian elimination 30 do 35 i = m+1, n do 37 j = m+1, n+1 a(i,j) = a(i,j) - a(i,m) * a(m,j) / a(m,m) 37 continue 35 continue 100 continue if (abs(a(n,n)). le. eps) go to 70 * back subsititution x(n) = a(n, n+1) / a(n,n) kk = ln(n) a(n, kk) = x(n) do 50 i = n-1, 1, -1 k = n-i x(i) = 0.0 do 52 j = 1, k ll = i + j x(i) = a(i, ll) * x(ll) + x(i) 52 continue x(i) = (a(i, n+1) - x(i)) / a(i,i) kk = ln(i) a(n, kk) = x(i) 50 continue do 60 i = 1, n x(i) = a(n, i) 60 continue return 70 ipivot = 0 return end

  • Fortran77のプログラム実行時にエラー

    Windows98でCPad for Salford FTN77というソフトを使って、Fortran77のプログラミングをしています。そこで学校での課題で、下のようなプログラムを作ったのですが、実行すると次のようなエラーがでます。 The insrtuction at address 0373f5b0 attempted to read from an illegal location 0373f5b0 routine at address 373F5B0 [+0000] 00401000 main [+074f] で、ファイルに書き込めてるかどうかチェックすると、何も書き込めていません。どうすれば、ちゃんと動くのでしょうか。どなたか分かる方、宜しくお願いします。 プログラム↓ *生徒50人の成績を読み込み平均点などを計算し、ファイルに書き込む PROGRAM GOKAMOKU HEIKIN INTEGER N(1:50),EP(1:50),MP(1:50),JP(1:50),SP(1:50),CP(1:50) INTEGER SUM(1:50),K,I,L,J,M,Q REAL PAV(1:50),PVX(1:50),PSD(1:50),EAV,ESD,MAV,MSD,JAV,JSD REAL SAV,SSD,CAV,CSD CHARACTER FNAME*30,SHUTURYOKU*20,CN*50,SHUTURYOKU2*20 READ(5,*)FNAME READ(5,*)SHUTURYOKU OPEN(1,FILE=FNAME) DO 10 K=1,50 READ(1,*)N(K),EP(K),MP(K),JP(K),SP(K),CP(K) 10 CONTINUE CLOSE(1) *英語の平均点、標準偏差の計算 OPEN(2,FILE=SHUTURYOKU) CALL AVEETC(EP,EAV,ESD) WRITE(2,*)'英語の平均点・標準偏差' WRITE(2,300) EAV,ESD 300 FORMAT(2F6.2) *数学の平均点、標準偏差の計算 CALL AVEETC(MP,MAV,MSD) WRITE(2,*)'数学の平均点・標準偏差' WRITE(2,300) MAV,MSD *国語の平均点、標準偏差の計算 CALL AVEETC(JP,JAV,JSD) WRITE(2,*)'国語の平均点・標準偏差' WRITE(2,300) JAV,JSD *理科の平均点、標準偏差の計算 CALL AVEETC(SP,SAV,SSD) WRITE(2,*)'理科の平均点・標準偏差' WRITE(2,300) SAV,SSD *社会の平均点、標準偏差の計算 CALL AVEETC(CP,CAV,CSD) WRITE(2,*)'社会の平均点・標準偏差' WRITE(2,300) CAV,CSD *各生徒の合計点、平均点、標準偏差の計算 DO 50 K=1,50 SUM(K)=EP(K)+MP(K)+JP(K)+SP(K)+CP(K) PVX(K)=EP(K)**2+MP(K)**2+JP(K)**2+SP(K)**2+CP(K)**2 PAV(K)=REAL(SUM(K))/5.0 PSD(K)=SQRT(PVX(K)/5.0-PAV(K)**2) 50 CONTINUE WRITE(2,*)'各生徒の合計点、平均点、標準偏差' WRITE(2,*)'番号 合計 平均点 標準偏差' DO 60 K=1,50 WRITE(2,200)K,SUM(K),PAV(K),PSD(K) 60 CONTINUE 200 FORMAT(I3,I5,2F10.2) *合計点のヒストグラムを書く DO 70 J=0,9 JL=10*J JH=JL+9 CALL STR(SUM(J),CN) WRITE(2,400)JL,JH,CN 70 CONTINUE 400 FORMAT(1X,I2,'-',I2,'I',A50) *英語の点数順に並べ変え DO 20 L=1,49 DO 30 I=L+1,50 IF(EP(L).LT.EP(I)) THEN M=EP(I) EP(I)=EP(L) EP(L)=M Q=N(I) N(I)=N(L) N(L)=Q END IF 30 CONTINUE 20 CONTINUE *表示 WRITE(2,*)'英語の成績高い順' WRITE(2,*)'番号 点数' DO 40 J=1,50 WRITE(2,100)N(J),EP(J) 40 CONTINUE 100 FORMAT(I2,I3) END SUBROUTINE AVEETC(P,AV,SD) REAL AV,SD INTEGER P(1:50) WX=0.0 VX=0.0 DO 10 K=1,50 WX=WX+P(K) VX=VX+P(K)*P(K) 10 CONTINUE AV=REAL(WX)/50.0 SD=SQRT(REAL(VX)/50.0-AV**2) END SUBROUTINE STR(SUM,C) INTEGER SUM CHARACTER C*50 DO 10 K=1,50 IF(K.LE.SUM(K))THEN C(K:K)='*' ELSE C(K:K)=' ' END IF 10 CONTINUE END

  • mの平方根の連分数展開なのですがうまく動きません。

    subroutine keisan(m) integer a,a0,n,i,m real t,X,Y,Z t=sqrt(real(m)) a0=int(t) write(*,*) 'a0=',a0 a=a0 X=1 Y=0 Z=1 do 10 n=1,20 if (Z==0.0) exit X=X*Z Y=Z*(-Y+real(a)*Z) Z=X*X*real(m)-(real(a)*Z-Y)**2 do 100 i=1,X if(real(i)==X) then X=X else if(((mod(int(X),i))==0).AND.((mod(int(Y),i))==0).AND.((mod(int(Z),i))==0)) then X=X/real(i) Y=Y/real(i) Z=Z/real(i) else X=X endif endif 100 continue a=int((X*t+Y)/Z) write(*,*) 'a',n,'=',a 10 continue end subroutine サブルーチンのみ載せてますけど・・・・どうなのでしょう??

  • 配列 x に入っているデータの最大値、最小値を求めるサブルーチンとそのヒストグラムの作り方

    配列 x に入っているデータの最大値、最小値を求めるサブルーチン maxmin(x,n,xmax,xmin) を作り方を教えてください。 n はデータ数。 最大値、最小値はそれぞれ xmin, xmax に代入する。 次に、そのサブルーチンを用い、x に入っているデータのヒストグラムを作成するプログラムを作り方も教えてください。 (途中までしか分かりません) implicit real*8(a-h,o-z) real*8 x(10000) integer count(100) ndiv = 40 分割数は 40 にする n = 10000 データ数は 10000 dummy = rand(13) 乱数の初期化 do 10 i=1, n sum = 0.0d0 do 20 j=1,5 sum = sum + rand(0) 5個の乱数の和 20 continue x(i) = sum 10 continue call maxmin(x,n,xmax,xmin) 最大・最小値を求める dx = (xmax - xmin)/ndiv 分割幅 !!count をゼロで初期化する do ループを追加!!(よく分かりません) !!ヒストグラムを作成する do ループを追加!!(よく分かりません) do 100 k=1, ndiv write(6,*) xmin+(k-0.5d0)*dx, count(k) データの中心値と個数を出力 100 continue stop end subroutine maxmin(x,n,xmax,xmin) implicit real*8(a-h,o-z) real*8 x(*) !!この部分を作成してサブルーチンの完成のさせ方が分かりません!! return end ところどころが分かりません。 とても困っていますし、急いでいます。 だれか教えてください。 よろしくお願いします。

専門家に質問してみよう