Lopatky v1

Optimalizace lopatkoveho kola

Imports System
Imports System.Collections.Concurrent
Imports LopatkyVb

Module Program

  Private Const MaxPocetIteraci As Integer = 10000

  Sub Main(args As String())

    Optimalizovat(500.0, 480.0, 490.0, 475.0, 492.0, 510.0, 505.0, 520.0, 470.0)

    Optimalizovat(10300.0, 10300.0, 10210.0, 10160.0, 10130.0, 10130.0, 10120.0, 10120.0, 10100.0, 10100.0, 10090.0, 10090.0, 10080.0, 10070.0, 10050.0, 10050.0, 10030.0, 10020.0)

    Console.WriteLine()
    Console.WriteLine("Neco zmacknout pro ukonceni")
    Console.ReadKey()
  End Sub

  Private Sub Optimalizovat(ParamArray hmotnosti As Double())
    Dim pocatecniKolo = New Kolo(hmotnosti)

    Dim iterace = 1
    Dim kolo = pocatecniKolo
    While iterace < MaxPocetIteraci AndAlso Iterovat(kolo)
      iterace += 1
    End While

    Console.WriteLine("Vstupni kolo:")
    VypsatKolo(pocatecniKolo)
    Console.WriteLine()

    Console.WriteLine("Vysledne kolo:")
    VypsatKolo(kolo)
    Console.WriteLine()

    Console.WriteLine("Pocet iteraci: {0:N0}", iterace)

    Console.WriteLine()
    Console.WriteLine("******")
    Console.WriteLine()
  End Sub

  Private Sub VypsatKolo(kolo As Kolo)
    Console.WriteLine("Vzdalenost teziste od pocatku: {0:N6}", Math.Sqrt(kolo.Teziste.VzdalenostOdPocatkuKvadrat))
    Console.WriteLine(String.Join("; ", From l In kolo Select String.Format("{0:N1}", l.Hmotnost)))
  End Sub

  ''' <summary>
  ''' Vrati true, pokud doslo k prohozeni
  ''' </summary>
  ''' <param name="kolo">Pouzije se zaroven jako vstupni hodnota pro kolo, ktere se ma optimalizovat, tak jako vystupni hodnota pro vysledne kolo.</param>
  Function Iterovat(ByRef kolo As Kolo) As Boolean
    Dim pocatecni = kolo
    Dim dosloKProhozeni = False
    For a = 0 To pocatecni.Count - 1
      For b = a + 1 To pocatecni.Count - 1
        Dim navrh = pocatecni.ProhoditLopatky(a, b)
        If navrh.Teziste.VzdalenostOdPocatkuKvadrat < kolo.Teziste.VzdalenostOdPocatkuKvadrat Then
          kolo = navrh
          dosloKProhozeni = True
        End If
      Next
    Next
    Return dosloKProhozeni
  End Function

End Module


Class Kolo
  Implements IReadOnlyList(Of Lopatka)

  Private ReadOnly Lopatky As IReadOnlyList(Of Lopatka)

  ''' <summary>
  ''' Nenulove cislo
  ''' </summary>
  ''' <returns></returns>
  Public ReadOnly Property Hmotnost As Double

  Public ReadOnly Property Teziste As Vektor

  Public Sub New(ParamArray hmotnosti As Double())
    If hmotnosti Is Nothing Then Throw New ArgumentNullException(NameOf(hmotnosti))
    Me.Hmotnost = hmotnosti.Sum()
    If Me.Hmotnost = 0.0 Then Throw New ArgumentException("Soucet hmotnosti nesmi byt nula.", NameOf(hmotnosti))
    Dim polohy = Caches.PolohyLopatek.GetValue(hmotnosti.Length)
    Me.Lopatky = New List(Of Lopatka)(hmotnosti.Zip(polohy, AddressOf Lopatka.Create))
    Me.Teziste = Me.SpocitatTeziste()
  End Sub

  Private Function SpocitatTeziste() As Vektor
    Dim result = Vektor.Origin
    For Each lopatka In Me.Lopatky
      result += lopatka.Hmotnost * lopatka.Teziste
    Next
    Return (1.0 / Me.Hmotnost) * result
  End Function

  ''' <summary>
  ''' Vytvori nove kolo s prohozenyma lopatkama na pozicich <paramref name="a"/> a <paramref name="b"/> (pocitano on nuly).
  ''' </summary>
  ''' <param name="a">index lopatky</param>
  ''' <param name="b">index druhe lopatky</param>
  Public Function ProhoditLopatky(a As Integer, b As Integer) As Kolo
    Dim h(Me.Lopatky.Count - 1) As Double
    For i = 0 To h.Length - 1
      Dim j = i
      If i = a Then
        j = b
      ElseIf i = b Then
        j = a
      End If
      h(i) = Me.Lopatky(j).Hmotnost
    Next
    Return New Kolo(h)
  End Function

#Region "Implemetace IReadOnlyList"

  Default Public ReadOnly Property Item(index As Integer) As Lopatka Implements IReadOnlyList(Of Lopatka).Item
    Get
      Return Lopatky(index)
    End Get
  End Property

  Public ReadOnly Property Count As Integer Implements IReadOnlyCollection(Of Lopatka).Count
    Get
      Return Lopatky.Count
    End Get
  End Property

  Public Function GetEnumerator() As IEnumerator(Of Lopatka) Implements IEnumerable(Of Lopatka).GetEnumerator
    Return Lopatky.GetEnumerator()
  End Function

  Private Function IEnumerable_GetEnumerator() As IEnumerator Implements IEnumerable.GetEnumerator
    Return Lopatky.GetEnumerator()
  End Function

#End Region

End Class

Class Lopatka

  Private Sub New(hmotnost As Double, poloha As Double, teziste As Vektor)
    If teziste Is Nothing Then
      Throw New ArgumentNullException(NameOf(teziste))
    End If

    Me.Hmotnost = hmotnost
    Me.Poloha = poloha
    Me.Teziste = teziste
  End Sub

  Public ReadOnly Property Hmotnost As Double

  ''' <summary>
  ''' Uhel v radianech
  ''' </summary>
  Public ReadOnly Property Poloha As Double

  Public ReadOnly Property Teziste As Vektor

  Public Shared Function Create(hmotnost As Double, poloha As Double) As Lopatka
    Return New Lopatka(hmotnost, poloha, Caches.TezisteLopatek.GetValue(poloha))
  End Function

End Class

Class Vektor

  Public Shared ReadOnly Property Origin As New Vektor(0.0, 0.0)

  Public ReadOnly Property X As Double

  Public ReadOnly Property Y As Double

  Private ReadOnly _VzdalenostOdPocatkuKvadrat As Lazy(Of Double)

  Public ReadOnly Property VzdalenostOdPocatkuKvadrat As Double
    Get
      Return Me._VzdalenostOdPocatkuKvadrat.Value
    End Get
  End Property

  Public Sub New(x As Double, y As Double)
    Me.X = x
    Me.Y = y
    Me._VzdalenostOdPocatkuKvadrat = New Lazy(Of Double)(AddressOf SpocitatVzdalenostOdPocatkuKvadrat)
  End Sub

  Private Function SpocitatVzdalenostOdPocatkuKvadrat() As Double
    Return Me.X * Me.X + Me.Y * Me.Y
  End Function

  Public Overrides Function ToString() As String
    Return $"[{X:N3}, {Y:N3}]"
  End Function

  Public Shared Operator *(left As Double, right As Vektor) As Vektor
    Return New Vektor(left * right.X, left * right.Y)
  End Operator

  Public Shared Operator +(left As Vektor, right As Vektor) As Vektor
    Return New Vektor(left.X + right.X, left.Y + right.Y)
  End Operator

End Class

Module Caches

  ''' <summary>
  ''' Vrati teziste pro polohy / uhly lopatek.
  ''' </summary>
  Public ReadOnly Property TezisteLopatek As New Cache(Of Double, Vektor)(AddressOf TezisteLopatky)

  Private Function TezisteLopatky(ByVal uhel As Double) As Vektor
    Return New Vektor(Math.Cos(uhel), Math.Sin(uhel))
  End Function

  ''' <summary>
  ''' Pro kazdy pocet lopatek vrati rozlozeni uhlu
  ''' </summary>
  Public ReadOnly Property PolohyLopatek As New Cache(Of Integer, IReadOnlyList(Of Double))(AddressOf GetPolohy)

  Private Function GetPolohy(ByVal n As Integer) As IReadOnlyList(Of Double)
    Return New List(Of Double)(From i In Enumerable.Range(1, n) Select 2.0 * Math.PI * i / n)
  End Function

End Module

Class Cache(Of TKey, TValue)

  Private ReadOnly Items As New System.Collections.Concurrent.ConcurrentDictionary(Of TKey, TValue)()

  Private ReadOnly GenerateValue As Func(Of TKey, TValue)

  Public Sub New(generateValue As Func(Of TKey, TValue))
    Me.GenerateValue = generateValue
  End Sub

  Public Function GetValue(key As TKey) As TValue
    Dim result As TValue
    If Not Me.Items.TryGetValue(key, result) Then
      result = GenerateValue(key)
      Me.Items.TryAdd(key, result)
    End If
    Return result
  End Function

End Class

Neformátovaný

Přidáno: 20.9.2019
Expirace: Neuvedeno

Autor: Bugmaster