Questo sito utilizza cookies solo per scopi di autenticazione sul sito e nient'altro. Nessuna informazione personale viene tracciata. Leggi l'informativa sui cookies.
Username: Password: oppure
Q-Learning - Form1.vb

Form1.vb

Caricato da: Totem
Scarica il programma completo

  1. Public Class Form1
  2.     Private Delegate Function BotAction(ByVal IsTest As Boolean) As Color
  3.     Private Q As ThreeDimensionsMatrix(Of Color, BotAction, Single)
  4.  
  5.     Private Colors As Color() = New Color() {Color.Yellow, Color.Green, Color.Orange, Color.LightBlue}
  6.     Private Grid(15)() As Color
  7.     Private Position As Point
  8.     Private LastAction As BotAction
  9.     Private LastColor As Color
  10.  
  11.  
  12.     Private Function MoveUp(ByVal IsTest As Boolean) As Color
  13.         If IsTest = False Then
  14.             Position.Y -= 1
  15.             If Position.Y < 0 Then Position.Y = 0
  16.             Return Grid(Position.X)(Position.Y)
  17.         Else
  18.             Return Grid(Position.X)(If(Position.Y > 0, Position.Y - 1, Position.Y))
  19.         End If
  20.     End Function
  21.  
  22.     Private Function MoveDown(ByVal IsTest As Boolean) As Color
  23.         If IsTest = False Then
  24.             Position.Y += 1
  25.             If Position.Y > 15 Then Position.Y = 15
  26.             Return Grid(Position.X)(Position.Y)
  27.         Else
  28.             Return Grid(Position.X)(If(Position.Y < 15, Position.Y + 1, Position.Y))
  29.         End If
  30.     End Function
  31.  
  32.     Private Function MoveLeft(ByVal IsTest As Boolean) As Color
  33.         If IsTest = False Then
  34.             Position.X -= 1
  35.             If Position.X < 0 Then Position.X = 0
  36.             Return Grid(Position.X)(Position.Y)
  37.         Else
  38.             Return Grid(If(Position.X > 0, Position.X - 1, Position.X))(Position.Y)
  39.         End If
  40.     End Function
  41.  
  42.     Private Function MoveRight(ByVal IsTest As Boolean) As Color
  43.         If IsTest = False Then
  44.             Position.X += 1
  45.             If Position.X > 15 Then Position.X = 15
  46.             Return Grid(Position.X)(Position.Y)
  47.         Else
  48.             Return Grid(If(Position.X < 15, Position.X + 1, Position.X))(Position.Y)
  49.         End If
  50.     End Function
  51.  
  52.     Private Sub Learn(ByVal Alpha As Single, ByVal Gamma As Single, ByVal Reward As Single)
  53.         Dim Current As Color = Grid(Position.X)(Position.Y)
  54.         Dim Max As Single = -1
  55.         Dim NextBestAction As BotAction
  56.  
  57.         For Each Action As BotAction In Q.Keys2
  58.             If Q(Current, Action) > Max Then
  59.                 Max = Q(Current, Action)
  60.                 NextBestAction = Action
  61.             End If
  62.         Next
  63.  
  64.         'Alpha = coefficiente di apprendimento
  65.         '  Se Alpha = 0, l'agente non apprende nulla;
  66.         '  Se Alpha = 1, l'agente tiene conto solo delle esperienze più recenti.
  67.         'Gamma = coefficiente di sconto
  68.         '  Se Gamma = 0, l'agente agisce per una ricompensa immediata
  69.         '  Se Gamma = 1, l'agente tiene conto delle ricompense che potrà ricevere alla prossima mossa
  70.         Q(LastColor, LastAction) = Q(LastColor, LastAction) * (1 - Alpha) + Alpha * (Reward + Gamma * Max)
  71.     End Sub
  72.  
  73.     Private Sub RefreshBestAction()
  74.         Dim Max As Single
  75.         Dim BestAction As BotAction
  76.         Dim Current As Color = Grid(Position.X)(Position.Y)
  77.  
  78.         Max = -1
  79.         BestAction = Nothing
  80.         Current = Grid(Position.X)(Position.Y)
  81.         For Each Action As BotAction In Q.Keys2
  82.             If Q(Current, Action) > Max Then
  83.                 Max = Q(Current, Action)
  84.                 BestAction = Action
  85.             End If
  86.         Next
  87.         lblPrevision.Text = "Previsione" & vbCrLf & "La prossima volta il bot eseguirà questa azione: " & BestAction.Method.Name
  88.     End Sub
  89.  
  90.  
  91.     Private Sub tmrRefresh_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles tmrRefresh.Tick
  92.         Dim B As New Bitmap(400, 400)
  93.         Dim G As Graphics = Graphics.FromImage(B)
  94.  
  95.         G.SmoothingMode = Drawing2D.SmoothingMode.AntiAlias
  96.         For I As Int16 = 0 To 15
  97.             For J As Int16 = 0 To 15
  98.                 G.FillRectangle(New SolidBrush(Grid(I)(J)), I * 25, J * 25, 25, 25)
  99.             Next
  100.         Next
  101.  
  102.         For N As Int16 = 0 To 16
  103.             G.DrawLine(Pens.Black, N * 25, 0, N * 25, B.Height)
  104.             G.DrawLine(Pens.Black, 0, N * 25, B.Width, N * 25)
  105.         Next
  106.  
  107.         G.DrawImage(My.Resources.kopete, New Point(Position.X * 25 + 1, Position.Y * 25 + 1))
  108.  
  109.         imgField.Image = B
  110.         G.Dispose()
  111.     End Sub
  112.  
  113.     Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
  114.         Dim Rnd As New Random()
  115.  
  116.         For I As Int16 = 0 To 15
  117.             ReDim Grid(I)(15)
  118.             For J As Int16 = 0 To 15
  119.                 Grid(I)(J) = Colors(Rnd.Next(Colors.Length))
  120.             Next
  121.         Next
  122.  
  123.         Q = New ThreeDimensionsMatrix(Of Color, BotAction, Single)(0)
  124.  
  125.         For Each C As Color In Colors
  126.             Q.AddKey1(C)
  127.         Next
  128.         Q.AddKey2(AddressOf MoveUp)
  129.         Q.AddKey2(AddressOf MoveDown)
  130.         Q.AddKey2(AddressOf MoveLeft)
  131.         Q.AddKey2(AddressOf MoveRight)
  132.         dgvSummary.DataSource = Q.InnerTable
  133.  
  134.         tmrRefresh.Start()
  135.     End Sub
  136.  
  137.     Private Sub btnDoAction_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnDoAction.Click
  138.         Dim BestAction As BotAction
  139.         Dim Max As Single = -1
  140.         Dim Current As Color = Grid(Position.X)(Position.Y)
  141.  
  142.         tmrRefresh.Stop()
  143.         For Each Action As BotAction In Q.Keys2
  144.             If Q(Current, Action) > Max Then
  145.                 Max = Q(Current, Action)
  146.                 BestAction = Action
  147.             End If
  148.         Next
  149.  
  150.         BestAction.Invoke(False)
  151.         LastAction = BestAction
  152.         LastColor = Current
  153.         lblAction.Text = BestAction.Method.Name
  154.         lblColor.Text = Current.Name
  155.         tmrRefresh.Start()
  156.         btnReward.Enabled = True
  157.         btnPunish.Enabled = True
  158.         Me.RefreshBestAction()
  159.     End Sub
  160.  
  161.     Private Sub btnReward_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnReward.Click
  162.         Learn(nudAlpha.Value / 100, nudGamma.Value / 100, 5)
  163.         Me.RefreshBestAction()
  164.     End Sub
  165.  
  166.     Private Sub btnPunish_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnPunish.Click
  167.         Learn(nudAlpha.Value / 100, nudGamma.Value / 100, -5)
  168.         Me.RefreshBestAction()
  169.     End Sub
  170.  
  171.     Private Sub dgvSummary_CellEnter(ByVal sender As System.Object, ByVal e As System.Windows.Forms.DataGridViewCellEventArgs) Handles dgvSummary.CellEnter
  172.         lblSummary.Text = String.Format("({0}, {1}) = {2}", Q.Keys1(e.ColumnIndex).Name, Q.Keys2(e.RowIndex).Method.Name, Q.InnerTable.Rows(e.RowIndex).Item(e.ColumnIndex).ToString())
  173.     End Sub
  174.  
  175.     Private Sub btnRefreshEverything_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnRefreshEverything.Click
  176.         tmrRefresh.Stop()
  177.         Q = Nothing
  178.         Form1_Load(Me, EventArgs.Empty)
  179.     End Sub
  180. End Class