FC2ブログ

スポンサーサイト 


上記の広告は1ヶ月以上更新のないブログに表示されています。
新しい記事を書く事で広告が消せます。

--/--/--

Category: スポンサー広告

TB: --  /  CM: --

top △

再帰処理にはまる(その5) 


以下の内容で、テーブル「T7」があるとします。
anターン名前順位
11A1
21C2
31H3
42J1
52D2
62C3
73B1
83A2
93C3
104B1
114A2
124C3

「ターン」は、俗に言う「何回戦」になります。
ここで、得点として、
・1位には、そのターン前までに所持していた、2位+3位の得点を加算
・2位には、そのターン前までに所持していた、3位の得点を加算
・元々各人は、10点所持している

以下の様な表示にしたい
anターン名前順位得点
11A130
21C220
31H310
42J140
52D230
62C320
73B160
83A250
93C320
104B1130
114A270
124C320

ターン1のA:Cの元々+Hの元々(10 + 10)+ Aの元々(10)= 30
ターン1のC:Hの元々(10)+ Cの元々(10)= 20
ターン2のJ:Dの元々+ターン1までのC(10 + 20)+ Jの元々(10)= 40
ターン2のD:ターン1までのC(20)+ Dの元々(10)= 30
ターン3のB:ターン2までのA+ターン2までのC(30 + 20)+ Bの元々(10)= 60
ターン3のA:ターン2までのC(20)+ターン2までのA(30)= 50
ターン4のB:ターン3までのA+ターン3までのC(50 + 20)+ ターン3までのB(60)= 130
ターン4のA:ターン3までのC(20)+ターン3までのA(50)= 70
といった感じの計算になるかと・・・・

なかなか面白い計算方法ですね。
後半になればなるほど、上位者に勝てば逆転が容易・・・・かなぁ??
ある程度、作戦が必要そう・・・・

この得点を求める・・・・初めに思いつくのは再帰処理でどうにか・・・・
以下の関数を作って、クエリから利用すると上記の表示になります。
Public Function ValSum(iTrn As Long, sName As String) As Long
  Dim rs As New ADODB.Recordset
  Dim iR As Long
  Dim bFound As Boolean

  If (iTrn < 1) Then
    iR = 10
  Else
    iR = 0
    bFound = False
    rs.Source = "SELECT * FROM T7 WHERE ターン=" & iTrn & " ORDER BY 順位;"
    rs.Open , CurrentProject.Connection, adOpenForwardOnly, adLockReadOnly
    While (Not rs.EOF)
      If (bFound Or (rs("名前") = sName)) Then
        iR = iR + ValSum(iTrn - 1, rs("名前"))
        bFound = True
      End If
      rs.MoveNext
    Wend
    rs.Close
    If (Not bFound) Then iR = ValSum(iTrn - 1, sName)
  End If
  ValSum = iR
End Function

 
クエリに記述した内容
SELECT an, ターン, 名前, 順位, ValSum(ターン,名前) AS 得点 FROM T7;

ただ、上記の記述だと・・・求めたい「ターン」から順次1つ前ではどうだったのか・・・・
これを見ているので、加算対象の人がそれ以前に居ない・・・等々無駄な処理になります。
しかも、毎回 Recordset を Open しているので、時間的にも??・・・・

という事で、違う書き方もしてみた。
 
以下では、求めたい対象者が以前のターンに存在しているか・・・・

元々のレコードセットでは、ORDER BY ターン DESC, 順位 としていたので、
存在していたら 直近のターンが1レコード目に・・・・
その1レコード目のターンを使って、そのターンに絞り込んで再帰的に処理・・・

クエリの記述には変更ありません。

Private Function ValSumSub(rs As ADODB.Recordset, sName As String) As Long
  Dim rsC As ADODB.Recordset
  Dim iR As Long
  Dim bFound As Boolean

  If (rs.EOF) Then
    iR = 10
  Else
    iR = 0
    bFound = False
    While (Not rs.EOF)
      If (bFound Or (rs("名前") = sName)) Then
        Set rsC = rs.Clone
        rsC.Filter = "ターン < " & rs("ターン") & " AND 名前 = '" & rs("名前") & "'"
        If (Not rsC.EOF) Then rsC.Filter = "ターン = " & rsC("ターン")
        iR = iR + ValSumSub(rsC, rs("名前"))
        rsC.Close
        Set rsC = Nothing
        bFound = True
      End If
      rs.MoveNext
    Wend
  End If
  ValSumSub = iR
End Function

Public Function ValSum(iTrn As Long, sName As String) As Long
  Dim rs As New ADODB.Recordset

  rs.Source = "SELECT * FROM T7 ORDER BY ターン DESC, 順位;"
  rs.Open , CurrentProject.Connection, adOpenStatic, adLockReadOnly
  rs.Filter = "ターン=" & iTrn
  ValSum = ValSumSub(rs, sName)
  rs.Close
End Function

 
※ ValSum 内では、指定された引数は存在するものとして処理

※ どちらの方法が速いのかは???
 (応答に満足すれば、どちらでも良い?のかな)
 それよりも、フィールド「得点」を追加し、「ターン」が終わった時点で更新すれば・・・・
 そうすれば、対象者の過去得点の最大値を求めて・・・加算するだけになるのかな・・・

※ もっと良い方法があるよ・・・・教えてください。


今回は、サンプルファイルはありません。


※ 質問はすぐに消えちゃいました。
 また、質問では、「ターン」内に「リーグ」が存在し、
 同一「ターン」内のリーグ間で、名前が重複するかもしれない??・・・
 雰囲気そんな内容でした・・・
 なので、不明なリーグの扱いを排除したものにしてみました。


【追記】
実際に試してみられた方はいらっしゃいますか?

ターン数が16とか・・・・(提示サンプルの4倍)程度でもメチャ遅くなりますね。
一応やってできない事は無いけど・・・・っていうレベルかと

素直に、テーブルに「得点」フィールドを設け、都度更新・・・・でしょうね

関連記事

2013/05/06

Category: やってみる

TB: --  /  CM: 0

top △

この記事に対するコメント

top △

コメントの投稿

Secret

top △


上記広告は1ヶ月以上更新のないブログに表示されています。新しい記事を書くことで広告を消せます。