sort -- テキストファイルの整列: アナクロなコンピューターエンジニアのつぶやき

テキストファイルのソートに取り組みます。方針としては、STDINからEOFまで行単位ですべて読み込み、ソートし、 結果をSTDOUTに書き出します。

その前に、sortを作成中にgetlin()のbugを見つけました。返す値が、NEWLINE一文字分少なく返していました。修正版は下記の通り。

c getlin.for -- get line from infile
      integer function getlin(line,u)
      integer*1 line(81+1)                ! MAXLINE(81)+1
      integer u
      integer*1 c,fgetc
      integer col

      if (fgetc(u,c) .ne. -1) then      ! EOF(-1)
          col = 0
          while (c .ne. 10) do ! NEWLINE(10)
               col = col + 1
               line(col) = c
               c = fgetc(u,c)
          end while
          line(col + 1) = 10            ! NEWLINE(10)
          line(col + 2) = -2            ! EOS(-2)
          getlin = col + 1
      else
          getlin = -1                       ! EOF(-1)
      end if
      return
      end

さて、sortのメインルーチンは下記のようになります。

RATFOR版は以下の通り。

# sort.r4 -- sort text line in memory
      character linbuf(MAXTEXT)
      integer gtext
      integer linptr(MAXPTR),nlines

      call initfile()

      if (gtext(linptr,nlines,linbuf,STDIN) == EOF) {
          call shell(linptr,nlines,linbuf)
          call ptext(linptr,nlines,linbuf,STDOUT)
          }
      else
          call error('too big to sort.')
      stop
      end

WATCOM fortran77版は、以下の通り。

c sort.for -- sort text line in memory
      integer*1 linbuf(500000)          ! MAXTEXT(500000)
      integer gtext
      integer linptr(1000),nlines       ! MAXPTR(1000)

      call initfile()

      if (gtext(linptr,nlines,linbuf,5) .eq. -1) then ! STDIN(5) EOF(-1)
          call shell(linptr,nlines,linbuf)
          call ptext(linptr,nlines,linbuf,6) ! STDOUT(6)
      else
          call error('too big to sort.')
      end if
      stop
      end

gtext()は、STDINからEOFまで読み込みます。すべて読み込めなかった場合(linbufがいっぱいなる場合、 または、MAXPTR行以上を読み込もうとした場合)は、EOF以外の値を返します。

RATFOR版は下記の通り。

# gtext.r4 -- get text lines into memory
      integer function gtext(linptr,nlines,linbuf,infile)
      character linbuf(MAXTEXT)
      integer getlin
      integer infile,lbp,len,linptr(MAXPTR),nlines

      nlines = 0
      lbp = 1
      repeat {
          len = getlin(linbuf(lbp),infile)
          if (len == EOF)
              break
          nlines = nlines + 1
          linptr(nlines) = lbp
          lbp = lbp + len + 1
          } until (lbp >= MAXTEXT-MAXLINE | nlines >= MAXPTR)
      gtext = len
      return
      end

WATCOM Fortran77版は下記の通り。

c gtext.for -- get text lines into memory
      integer function gtext(linptr,nlines,linbuf,infile)
      integer*1 linbuf(500000)          ! MAXTEXT(500000)
      integer getlin
      integer infile,lbp,len,linptr(1000),nlines ! MAXPTR(1000)

      nlines = 0
      lbp = 1
      loop
          len = getlin(linbuf(lbp),infile)
          if (len .eq. -1) then         ! EOF(-1)
              exit
          end if
          nlines = nlines + 1
          linptr(nlines) = lbp
          lbp = lbp + len + 1
      until ((lbp .ge. 500000-82) .or. (nlines .ge. 1000)) ! MAXTEXT(500000) MAXLINE(82) MAXPTR(1000)
      gtext = len
      return
      end

shell()は、読み込んだ行をシェルソートを使って、ソートします。 行単位の比較はcompar()で、行の交換はexchan()で行います。

shell()のRATFOR版は下記の通り。

# shell.r4 -- shell sort for character lines
      subroutine shell(linptr,nlines,linbuf)
      character linbuf(ARB)
      integer gap,i,ig,j,k,linptr(ARB),nlines
      integer compar 

      for (gap = nlines/2; gap > 0; gap = gap/2)
          for (j = gap + 1; j <= nlines; j = j + 1)
              for (i = j - gap; i > 0; i = i - gap) {
                  ig = i + gap
                  if (compar(linptr(i),linptr(ig),linbuf) <= 0)
                      break
                  call exchan(linptr(i),linptr(ig),linbuf)
                  }
      return
      end

shell()のWATCOM Fortran77版は下記の通り。

c shell.for -- shell sort for character lines
      subroutine shell(linptr,nlines,linbuf)
      integer*1 linbuf(*)               ! ARB(*)
      integer gap,i,ig,j,linptr(*),nlines ! ARB(*)
      integer compar

      gap = nlines/2
      while (gap .gt. 0) do
          j = gap + 1
          while (j .le. nlines) do
              i = j - gap
              while (i .gt. 0) do
                  ig = i + gap
                  if (compar(linptr(i),linptr(ig),linbuf) .le. 0) then
                       exit
                  end if
                  call exchan(linptr(i),linptr(ig),linbuf)
                  i = i - gap
              end while
              j = j + 1
          end while
          gap = gap/2
      end while
      return
      end

行を比較するcompar()は、小さければ-1を等しければ0を大きければ1を返します。比較は文字コード順です。

RATFOR版は下記の通り。

# compar.r4 -- compare linbuf(lp1) with linbuf(lp2)
      integer function compar(lp1,lp2,linbuf)
      character linbuf(ARB)
      integer i,j,lp1,lp2

      i = lp1
      j = lp2
      while (linbuf(i) == linbuf(j)) {
          if (linbuf(i) == EOS) {
              compar = 0
              return
              }
          i = i + 1
          j = j + 1
          }
      
      if (linbuf(i) < linbuf(j))
          compar = -1
      else
          compar = +1
      return
      end

WATCOM Fortran77版は下記の通り。

c compar.for -- compare linbuf(lp1) with linbuf(lp2)
      integer function compar(lp1,lp2,linbuf)
      integer*1 linbuf(*)               ! ARB(*)
      integer i,j,lp1,lp2

      i = lp1
      j = lp2
      while (linbuf(i) .eq. linbuf(j)) do
          if (linbuf(i) .eq. -2) then   ! EOS(-2)
              compar = 0
              return
          end if
          i = i + 1
          j = j + 1
      end while

      if (linbuf(i) .lt. linbuf(j)) then
          compar = -1
      else
          compar = +1
      end if
      return
      end

行を交換するexchan()は、対象行へのポインターを交換し、実際の行データーは動かしません。

RATFOR版は下記の通り。

# exchan.r4 -- exchange linbuf(lp1) with linbuf(lp2)
      subroutine exchan(lp1,lp2,linbuf)
      character linbuf(ARB)
      integer k,lp1,lp2

      k = lp1
      lp1 = lp2
      lp2 = k
      return
      end

WATCOM Fortran77版は下記の通り。

c exchan.for -- exchange linbuf(lp1) with linbuf(lp2)
      subroutine exchan(lp1,lp2,linbuf)
      integer*1 linbuf(*)               ! ARB(*)
      integer k,lp1,lp2

      k = lp1
      lp1 = lp2
      lp2 = k
      return
      end

ソートした結果を書き出すptext()は、ラインポインターに基づいて、行を書き出します。

RATFOR版は下記の通り。

# ptext.r4 -- output text lines from linbuf
      subroutine ptext(linptr,nlines,linbuf,outfil)
      character linbuf(ARB)
      integer i,j,linptr(MAXPTR),nlines,outfil

      for (i = 1; i <= nlines; i = i + 1) {
          j = linptr(i)
          call putlin(linbuf(j),outfil)
          }
      return
      end

WATCOM Fortran77版は下記の通り。

c ptext.for -- output text lines from linbuf
      subroutine ptext(linptr,nlines,linbuf,outfil)
      integer*1 linbuf(*)               ! ARB(*)
      integer i,j,linptr(1000),nlines,outfil ! MAXPTR(1000)

      i = 1
      while (i .le. nlines) do
          j = linptr(i)
          call putlin(linbuf(j),outfil)
          i = i + 1
      end while
      return
      end