問題概要

単語がくっついた文字列が与えられるので単語で区切って並び替えて出力してね、という問題です。

解答までの道程

とりあえず大文字のところで区切られているようなので、大文字かどうか調べる関数を作ります。

logical function Omoji(x)
character(1)::x
Omoji=(ichar(x)>=ichar("A").and.ichar(x)<=ichar("Z"))
end function

大文字かどうか確認するすべを手に入れたところで、単語を配列にしてみます。

    character(10**5)::S
    character(10**5)::W(1:10**5)
    integer::WS,WE,Wcnt
    integer::i
    read*,S
    WS=1;Wcnt=0
    do i=1,len_trim(S)
        if(i==WS)cycle
        if( Omoji(S(i:i)) )then
            WE=i
            Wcnt=Wcnt+1
            W(Wcnt)=S(WS:WE)
            WS=WE+1
        endif
    end do

これでWに単語一つ一つをいれることができました。これをヒープソートしてやればできるはずです。

サンプルで試してみました。

FisHDoGCaTAAAaAAbCAC を入力すると AAACAaAAbCCaTDoGFisH が出てきました。答えは AAAaAAbCACCaTDoGFisH なのでちょっとおかしいですね。ACがAaAよりも先にきてしまっています。これはCが大文字だからでしょう。ヒープソートをする時は全部小文字にしてやって比較する必要があるんですね。

というわけで突っ込むときに小文字になるようにしました。

    do i=1,len_trim(S)
        if(i==WS)then
            S(i:i)=char(ichar(S(i:i)) -ichar("A")+ichar("a") )
            cycle
        endif
        if( Omoji(S(i:i)) )then
            WE=i
            Wcnt=Wcnt+1
            S(i:i)=char(ichar(S(i:i)) -ichar("A")+ichar("a") )
            W(Wcnt)=S(WS:WE)
            WS=WE+1
        endif
    end do

サンプルも合ったしこれで大丈夫、、、？　

f:id:kapt0nH:20200919234945p:plain — コンパイルエラーが出ました。

Main.f08:(.text+0x44): relocation truncated to fit: R_X86_64_PC32 against `.bss' で調べてみるとメモリを使いすぎてるようなことがわかります。確かに出てくる単語の長さも個数も分からないからといって100000文字の単語を100000個記憶させるのは無理がありそうです、、、

記憶量を減らすにはまず単語の量を測ってからその分だけメモリを確保すればいいんでしょうか？　単語の長さが事前に分からないのでfortranではそこまでメモリの確保量はかわらなそうです。

そもそも文字列Sがあるのに同じようなことをいちいち記憶する必要はなさそうです。各単語の最初の文字の位置と最後の文字の位置だけを記録して並び替えることにしましょう。

    type WSWE
        integer::H,O
    end type

(H)初めの文字と(O)終わりの文字をセットにして記憶させます。これをヒープソートにかけます。ヒープソートの中の比較演算子をいちいちいじりたくないのでオーバーロードを使います。(BADやNICEでもコンボが続きそうですね)

    interface operator (<)
        module procedure lessWSWE
    end interface operator (<)

 
logical function lessWSWE(X,Y)
    type(WSWE),intent(in)::X,Y
    lessWSWE=S(X%H:X%O)<S(Y%H:Y%O)
end function

比較演算子は<だけやっておけば<=とか>もよしなにしてくれるみたいですね。

ともかくこうしてACすることができました。

実装

module WSWE_mod
    character(10**5)::S
    type WSWE
        integer::H,O
    end type
    interface operator (<)
        module procedure lessWSWE
    end interface operator (<)
contains
 
logical function lessWSWE(X,Y)
    type(WSWE),intent(in)::X,Y
    lessWSWE=S(X%H:X%O)<S(Y%H:Y%O)
end function
end module 
program PAST
    use WSWE_mod
    implicit none
    integer::WS,WE,Wcnt,Wnum=0
    type(WSWE),allocatable,dimension(:)::W
    integer::i
    read*,S
    do i=1,len_trim(S)
        if( Omoji(S(i:i)) )WNum=Wnum+1
    end do
    Wnum=Wnum/2
    allocate(W(Wnum))
 
    WS=1;Wcnt=0
    do i=1,len_trim(S)
        if(i==WS)then
            S(i:i)=char(ichar(S(i:i)) -ichar("A")+ichar("a") )
            cycle
        endif
        if( Omoji(S(i:i)) )then
            WE=i
            Wcnt=Wcnt+1
            S(i:i)=char(ichar(S(i:i)) -ichar("A")+ichar("a") )
            W(Wcnt)%H=WS
            W(Wcnt)%O=WE
            WS=WE+1
        endif
    end do
    call heapsort(Wnum,W(1:Wcnt))
    do i=1,Wnum
        write(*,"(A)",advance='no') char(ichar(S(W(i)%H:W(i)%H)) -ichar("a")+ichar("A") )
        write(*,"(A)",advance='no') S(W(i)%H+1:W(i)%O-1)
        write(*,"(A)",advance='no') char(ichar(S(W(i)%O:W(i)%O)) -ichar("a")+ichar("A") )
    end do
contains
logical function Omoji(x)
character(1)::x
Omoji=(ichar(x)>=ichar("A").and.ichar(x)<=ichar("Z"))
end function
subroutine heapsort(n,array)
  implicit none
!ここの入力は状況に応じて変更すること
  integer,intent(in) :: n
  type(WSWE),intent(inout) :: array(1:n)
  integer::i,k,j,l
  type(WSWE):: t
 
  l=n/2+1
  k=n
  do while(k /= 1)
     if(l > 1)then
        l=l-1
        t=array(L)
     else
        t=array(k)
        array(k)=array(1)
        k=k-1
        if(k == 1) then
           array(1)=t
           exit
        endif
     endif
     i=l
     j=l+l
     do while(j<=k)
        if(j < k)then
           if(array(j) < array(j+1))j=j+1
        endif
        if (t < array(j))then
           array(i)=array(j)
           i=j
           j=j+j
        else
           j=k+1
        endif
     enddo
     array(i)=t
  enddo
  return
end subroutine heapsort
 
end program PAST

おしまい。

参考

amanotk.github.io

しずくぶろぐ

競技ぷろぐらみんぐしたり、なんかしたりします

不定期解説記事企画第一回アルゴリズム実技検定過去問 F #雫ぷよ

問題概要

解答までの道程

実装

参考