1program answer
2 implicit none
3 integer, parameter :: num_alphabet = 26
4 integer, parameter :: upper_a = ichar('A')
5 integer, parameter :: lower_a = ichar('a')
6 integer, parameter :: upper_z = ichar('Z')
7 integer, parameter :: lower_z = ichar('z')
8
9 integer :: i, iostat
10 integer :: hist(num_alphabet)
11 character(len=256) :: text
12
13 ! ヒストグラムを初期化
14 hist = 0
15
16 ! EOFまで読み続ける
17 read(*, fmt='(a)', iostat=iostat) text
18 do while(iostat == 0)
19 call count_alphabet(text, hist)
20 read(*, fmt='(a)', iostat=iostat) text
21 enddo
22
23 ! ヒストグラムを表示 (最大で60文字分)
24 call print_histogram(hist, 60)
25
26 stop
27contains
28 !
29 ! 小文字のアルファベットを大文字に変換する
30 !
31 function toupper(ch) result(r)
32 character, intent(in) :: ch
33 character :: r
34
35 integer :: ich
36
37 ! デフォルト値
38 r = ch
39
40 ich = ichar(ch)
41 if(ich >= lower_a .and. ich <= lower_z) then
42 ! 文字コードが'a'以上'z'以下なら小文字なので大文字に変換する
43 r = char(ichar(ch) - (lower_a - upper_a))
44 endif
45
46 endfunction toupper
47
48 !
49 ! 与えられた文字列に含まれるアルファベットの出現回数を調べる
50 !
51 subroutine count_alphabet(text, hist)
52 implicit none
53 character(*), intent(in) :: text
54 integer, intent(out) :: hist(num_alphabet)
55
56 integer :: i, ich, n
57
58 n = len(text)
59 do i = 1, n
60 ich = ichar(toupper(text(i:i))) - upper_a + 1
61 if(ich < 0 .or. ich > num_alphabet) then
62 cycle ! A-Z 以外は無視
63 endif
64 hist(ich) = hist(ich) + 1
65 enddo
66
67 endsubroutine count_alphabet
68
69 !
70 ! ヒストグラムを出力
71 !
72 subroutine print_histogram(hist, hmax)
73 implicit none
74 integer, intent(in) :: hist(num_alphabet)
75 integer, intent(in) :: hmax
76
77 integer :: i, j
78 real(8) :: norm
79 character(len=128) :: str
80
81 ! 文字数が多すぎる時はhmaxで規格化する
82 if(maxval(hist) > hmax) then
83 norm = real(hmax, 8) / real(maxval(hist), 8)
84 else
85 norm = 1.0_8
86 endif
87
88 do i = 1, num_alphabet
89 ! ヒストグラムの長さの分だけ文字列を'o'で埋める
90 str = ''
91 do j = 1, nint(hist(i) * norm)
92 str(j:j) = 'o'
93 enddo
94 ! 表示
95 write(*, fmt='(a1, "(", i4, "):", a)') &
96 & char(upper_a + i - 1), hist(i), trim(str)
97 enddo
98
99 endsubroutine print_histogram
100
101endprogram answer