Visual Basicの質問です(というかなんというか)

ファイルからデータを逐次読み込んでいって、その中央値(メディアン)を計算したいのです。平均値だと

sum=0:ct=0
open "file.txt" for input as #1
do
input #1,dat
ct=ct+1
sum=sum+dat
loop until eof(1)
close #1
avg=sum/ct

でいけますが、メディアンはやはり配列変数に読み込んでソーティングしないと無理なのでしょうか?
できれば、配列変数を用いないで上のような形でできないものでしょうか?

回答の条件
  • 1人2回まで
  • 登録:2006/05/26 00:13:36
  • 終了:2006/05/30 14:24:11

ベストアンサー

id:gong1971 No.5

gong1971回答回数443ベストアンサー獲得回数682006/05/30 12:41:14

ポイント50pt

大変お待たせ致しました。いやぁ、いざやってみると結構複雑でした。

Excelでサンプルデータを作ってテストしたので、多分間違っていないと思いますが、

確信は無いのでi_kumagoroさんの方法で計算した方が間違えがなくて確実かも。


前述の通り、平均値を求めて、そこから中央値に近付く方法で組んでみました。

件数が多ければ早く処理できると思うのですが...。


ちなみに偶数の場合は2つの平均というのが無ければ、もっと楽なんですけどね...。

自己満足で作りましたがご参考まで。

Function medianVB()
Dim i As Integer 'カウンタ
Dim ic As Integer '無限ループ対策
Dim av As Double '平均値
Dim ma As Double '最大値
Dim mi As Double '最小値
Dim cc As Integer '大きい値から数えた中央値の位置
Dim tp As Integer '件数が偶数なら1、奇数なら0
Dim mm As Double 'ターゲット値
Dim m1 As Double '中央値1
Dim lc As Integer '該当する個数
Dim sc As Integer '同じ値の個数
Dim rd As Integer 'データ読み込み用
Dim sr As Boolean
    Open "med.txt" For Input As #1
    
    i = 0
    av = 0
    ma = 1000
    mi = 0
    '件数,平均値,最大値を求める
    Do Until EOF(1)
        Input #1, rd
        av = av + rd
        i = i + 1
    Loop
    cc = i
    av = av / cc
    tp = (cc + 1) Mod 2
    cc = Int((cc + 1) / 2)
    
    '平均値よりも大きい最小の値を探す
    mm = FindNextNum(av, sc, lc, ma, True)
    If cc <= lc And cc >= (lc - sc) Then
        If (tp = 0) Or (tp = 1 And ((cc + tp) <= lc)) Then
            '探した値が中央値の時
            medianVB = mm
            Close
            Exit Function
        Else
            '探した値と次の値が中央値の時
            m1 = mm
            mm = FindNextNum(m1, sc, lc, mi, False)
            medianVB = (m1 + mm) / 2
            Close
            Exit Function
        End If
    Else
        If cc < lc Then
            sr = True
        Else
            sr = False
            ma = mi
        End If
        ic = 0
        Do
            mm = FindNextNum(mm, sc, lc, ma, sr)
            If cc <= lc And cc >= (lc - sc) Then
                If (tp = 0) Or (tp = 1 And ((cc + tp) <= lc)) Then
                    medianVB = mm
                    Close
                    Exit Function
                Else
                    m1 = mm
                    mm = FindNextNum(m1, sc, lc, mi, False)
                    medianVB = (m1 + mm) / 2
                    Close
                    Exit Function
                End If
            End If
            ic = ic + 1
            If ic > cc Then
                Stop
            End If
        Loop
    End If
End Function
Function FindNextNum(tn As Double, sc As Integer, lc As Integer, ByVal mm As Integer, sr As Boolean) As Integer
'tn:基準値
'sc:FindNextNumと同値の個数-1
'lc:該当する個数
'mm:最大値/最小値
'sr:True=基準値よりも大きい数値を探す
Dim rd As Integer
    
    Seek 1, 1
    sc = 0
    lc = 0
    Do Until EOF(1)
        Input #1, rd
        If sr Then
            If tn < rd Then
                lc = lc + 1
                If mm > rd Then
                    mm = rd
                    sc = 0
                ElseIf mm = rd Then
                    sc = sc + 1
                End If
            End If
        Else
            If tn > rd Then
                If mm < rd Then
                    mm = rd
                    sc = 0
                ElseIf mm = rd Then
                    sc = sc + 1
                End If
            Else
                lc = lc + 1
            End If
        End If
    Loop
    If sr = False Then
        lc = lc + sc + 1
    End If
    FindNextNum = mm
End Function
id:ichi-pooh-MT

すばらしいです!

試してみますね。

ありがとうございます!

2006/05/30 14:22:41

その他の回答(4件)

id:Allashe No.1

Allashe回答回数59ベストアンサー獲得回数52006/05/26 06:37:37

 下のページの下のほうに、

'配列の中央値を求める

 というのがあります。

http://www.kms.ac.jp/~clinilab/person/ing/lib/static.bas


 中央値の算出について、一般式が

http://aoki2.si.gunma-u.ac.jp/lecture/Univariate/median.html

にあります。

id:ichi-pooh-MT

ありがとうございます。

データを配列変数に格納するなら、いろいろ手立てはありそうですね。ただ、ぐうたらなので、できれば、配列を使いたくない(^^;)

青木先生のページは僕も良く使わせていただいています。

2006/05/26 07:45:27
id:Allashe No.2

Allashe回答回数59ベストアンサー獲得回数52006/05/26 06:56:32

ポイント25pt

 すみません!先ほどのプログラムをExcelで検証してみましたが、ソートされていることが前提になっていて、うまく動作しません。

 Excelならmedian関数があるのですが、これも多分内部でソートして計算しているのだと思います。

 お力になれずすみませんでした。

id:ichi-pooh-MT

そうですね。配列のちょうど真ん中を選び出すプログラムみたいでした。

でも、ありがとうございます。m(_ _)m

2006/05/26 07:46:33
id:i_kumagoro No.3

i_kumagoro回答回数170ベストアンサー獲得回数582006/05/26 09:58:56

ポイント25pt

要素数がメモリを逼迫するほど多いとかでなければお勧めはしませんが(そうであっても大分改良が必要だと思います)、

  1. ファイルを読み込んでいって要素数を数える。
  2. ファイルをもう一度読み込んで一番大きな値とその要素数を数える(1. の時に数えてもよい)。
  3. ファイルをもう一度読み込んで次に大きな値とその要素数を数える。
  4. 3. を中央のの順位に来るまで繰り返す。

でできなくはないです。

例えば

1, 3, 4, 5, 6, 6, 7, 8, 10, 11, 11, 13

の様なデータがあったとすれば(ソートされている必要はありません)

  1. 最初の読み込み要素数12をカウント
  2. 次の読み込みで最大値13, 要素数1を得る。
  3. 次の読み込みで次に大きな値11, 要素数2を得る。
  4. 次の読み込みで次に大きな値10, 要素数1を得る。
  5. 次の読み込みで次に大きな値8, 要素数1を得る。
  6. 次の読み込みで次に大きな値7, 要素数1を得る。6位の7を得る。
  7. 次の読み込みで次に大きな値6, 要素数2を得る。7位の6を得る。
  8. (7+6)/2で中央値は6.5。

の様になります。読み込みループでは現在の順位と前回読み込みの最大値を憶えておけばよいので配列はいりません。

VBのコードは書けないのでだらだらとした説明になってすみません。

id:ichi-pooh-MT

反復横とび、じゃない、反復読み込みで中央部を見つける方法ですね。力技ですね。こういうやり方もあるのか、と勉強になります。

ありがとうございます。

最大値と最小値のチェックをうまくやっていけば、反復横とび(じゃないって)をしなくても中央にたどり着けるのかもしれないですね...

2006/05/26 10:17:32
id:gong1971 No.4

gong1971回答回数443ベストアンサー獲得回数682006/05/26 12:14:21

配列を使う方が明らかに効率的ですが、パズルとして楽しんで解法を探っています。

色々考えましたが、反復横飛び(じゃない!)反復読み込みになるでしょうね。

私は少しでも効率的に...と思って、平均値から探す方法を考えています。


が、考えると結構複雑でして(楽しいから全然良いのだけど)、出来たら閉じずに

もう少し待って貰えると助かります。(ただいま作成中です)

id:ichi-pooh-MT

お待ちしてます(^^)

いつもじゃまくさいので平均値を使っているのですが、データにばらつきが多いとメディアンはどうなってるんだろうと気になりつつもほったらかしてます。

2006/05/26 14:45:43
id:gong1971 No.5

gong1971回答回数443ベストアンサー獲得回数682006/05/30 12:41:14ここでベストアンサー

ポイント50pt

大変お待たせ致しました。いやぁ、いざやってみると結構複雑でした。

Excelでサンプルデータを作ってテストしたので、多分間違っていないと思いますが、

確信は無いのでi_kumagoroさんの方法で計算した方が間違えがなくて確実かも。


前述の通り、平均値を求めて、そこから中央値に近付く方法で組んでみました。

件数が多ければ早く処理できると思うのですが...。


ちなみに偶数の場合は2つの平均というのが無ければ、もっと楽なんですけどね...。

自己満足で作りましたがご参考まで。

Function medianVB()
Dim i As Integer 'カウンタ
Dim ic As Integer '無限ループ対策
Dim av As Double '平均値
Dim ma As Double '最大値
Dim mi As Double '最小値
Dim cc As Integer '大きい値から数えた中央値の位置
Dim tp As Integer '件数が偶数なら1、奇数なら0
Dim mm As Double 'ターゲット値
Dim m1 As Double '中央値1
Dim lc As Integer '該当する個数
Dim sc As Integer '同じ値の個数
Dim rd As Integer 'データ読み込み用
Dim sr As Boolean
    Open "med.txt" For Input As #1
    
    i = 0
    av = 0
    ma = 1000
    mi = 0
    '件数,平均値,最大値を求める
    Do Until EOF(1)
        Input #1, rd
        av = av + rd
        i = i + 1
    Loop
    cc = i
    av = av / cc
    tp = (cc + 1) Mod 2
    cc = Int((cc + 1) / 2)
    
    '平均値よりも大きい最小の値を探す
    mm = FindNextNum(av, sc, lc, ma, True)
    If cc <= lc And cc >= (lc - sc) Then
        If (tp = 0) Or (tp = 1 And ((cc + tp) <= lc)) Then
            '探した値が中央値の時
            medianVB = mm
            Close
            Exit Function
        Else
            '探した値と次の値が中央値の時
            m1 = mm
            mm = FindNextNum(m1, sc, lc, mi, False)
            medianVB = (m1 + mm) / 2
            Close
            Exit Function
        End If
    Else
        If cc < lc Then
            sr = True
        Else
            sr = False
            ma = mi
        End If
        ic = 0
        Do
            mm = FindNextNum(mm, sc, lc, ma, sr)
            If cc <= lc And cc >= (lc - sc) Then
                If (tp = 0) Or (tp = 1 And ((cc + tp) <= lc)) Then
                    medianVB = mm
                    Close
                    Exit Function
                Else
                    m1 = mm
                    mm = FindNextNum(m1, sc, lc, mi, False)
                    medianVB = (m1 + mm) / 2
                    Close
                    Exit Function
                End If
            End If
            ic = ic + 1
            If ic > cc Then
                Stop
            End If
        Loop
    End If
End Function
Function FindNextNum(tn As Double, sc As Integer, lc As Integer, ByVal mm As Integer, sr As Boolean) As Integer
'tn:基準値
'sc:FindNextNumと同値の個数-1
'lc:該当する個数
'mm:最大値/最小値
'sr:True=基準値よりも大きい数値を探す
Dim rd As Integer
    
    Seek 1, 1
    sc = 0
    lc = 0
    Do Until EOF(1)
        Input #1, rd
        If sr Then
            If tn < rd Then
                lc = lc + 1
                If mm > rd Then
                    mm = rd
                    sc = 0
                ElseIf mm = rd Then
                    sc = sc + 1
                End If
            End If
        Else
            If tn > rd Then
                If mm < rd Then
                    mm = rd
                    sc = 0
                ElseIf mm = rd Then
                    sc = sc + 1
                End If
            Else
                lc = lc + 1
            End If
        End If
    Loop
    If sr = False Then
        lc = lc + sc + 1
    End If
    FindNextNum = mm
End Function
id:ichi-pooh-MT

すばらしいです!

試してみますね。

ありがとうございます!

2006/05/30 14:22:41
  • id:ichi-pooh-MT
    みなさん、こんな馬鹿な質問にも真摯にお答えいただき、本当にありがとうございました。
    平均値から近づくという方法、おもしろそうですね。試してみます。

この質問への反応(ブックマークコメント)

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

絞り込み :
はてなココの「ともだち」を表示します。
回答リクエストを送信したユーザーはいません