Imports System.CodeDom
Imports System.CodeDom.Compiler
Imports System.Reflection
Imports System.ComponentModel
Public Class IntervalConverter
Inherits ExpandableObjectConverter
Public Shared DefaultConverter As New IntervalConverter()
Public Overrides Function CanConvertFrom(ByVal context As System.ComponentModel.ITypeDescriptorContext, ByVal sourceType As System.Type) As Boolean
Return (sourceType Is GetType(String))
End Function
Public Overrides Function CanConvertTo(ByVal context As System.ComponentModel.ITypeDescriptorContext, ByVal destinationType As System.Type) As Boolean
Return (destinationType Is GetType(Interval))
End Function
Public Overrides Function ConvertFrom(ByVal context As System.ComponentModel.ITypeDescriptorContext, ByVal culture As System.Globalization.CultureInfo, ByVal value As Object) As Object
If TypeOf value Is String Then
Dim Str As String = value
Dim Bounds() As String = Str.Split(",")
If Bounds.Length < 2 Then
Return Nothing
End If
Dim Result As Interval
Dim LowerStr As String = Bounds(0).Trim().ToLower()
Dim UpperStr As String = Bounds(1).Trim().ToLower()
If LowerStr = "-infinity" Or LowerStr = "-infinito" Or LowerStr = "negativeinfinity" Then
Result.LowerBound = Double.NegativeInfinity
Else
Result.LowerBound = CType(Bounds(0).Trim, Double)
End If
If UpperStr = "+infinity" Or LowerStr = "+infinito" Or UpperStr = "positiveinfinity" Then
Result.UpperBound = Double.PositiveInfinity
Else
Result.UpperBound = CType(Bounds(1).Trim, Double)
End If
Return Result
End If
Return MyBase.ConvertFrom(context, culture, value)
End Function
Public Overrides Function ConvertTo(ByVal context As System.ComponentModel.ITypeDescriptorContext, ByVal culture As System.Globalization.CultureInfo, ByVal value As Object, ByVal destinationType As System.Type) As Object
If TypeOf value Is Interval Then
Dim Int As Interval = value
Return String.Format("{0}, {1}", Int.LowerBound, Int.UpperBound)
End If
Return MyBase.ConvertTo(context, culture, value, destinationType)
End Function
End Class
Public Structure Interval
Public Shared ReadOnly R As New Interval(Double.NegativeInfinity, Double.PositiveInfinity)
Private _LowerBound As Double
Private _UpperBound As Double
<Browsable(True), _
DisplayName("Estremo inferiore")> _
Public Property LowerBound() As Double
Get
Return _LowerBound
End Get
Set(ByVal value As Double)
_LowerBound = value
End Set
End Property
<Browsable(True), _
DisplayName("Estremo superiore")> _
Public Property UpperBound() As Double
Get
Return _UpperBound
End Get
Set(ByVal value As Double)
_UpperBound = value
End Set
End Property
<Browsable(False)> _
Public ReadOnly Property Length() As Double
Get
Return Me.UpperBound - Me.LowerBound
End Get
End Property
Sub New(ByVal LowerBound As Double, ByVal UpperBound As Double)
Me.LowerBound = LowerBound
Me.UpperBound = UpperBound
End Sub
Public Function IsXIncluded(ByVal X As Double) As Boolean
Return (X >= Me.LowerBound) And (X <= Me.UpperBound)
End Function
Public Function Intersects(ByVal I As Interval)
If Me.LowerBound = I.LowerBound Or Me.LowerBound = I.UpperBound Or _
Me.UpperBound = I.LowerBound Or Me.UpperBound = I.UpperBound Then
Return True
End If
If ((Me.LowerBound > I.LowerBound) And Not (Me.LowerBound > I.UpperBound)) Or _
((Me.UpperBound < I.UpperBound) And Not (Me.UpperBound < I.LowerBound)) Then
Return True
Else
Return False
End If
End Function
Public Shared Function Union(ByVal I1 As Interval, ByVal I2 As Interval) As Interval?
If Not I1.Intersects(I2) Then
Return Nothing
End If
Dim Result As Interval
Result.LowerBound = Math.Min(I1.LowerBound, I2.LowerBound)
Result.UpperBound = Math.Max(I1.UpperBound, I2.UpperBound)
Return Result
End Function
Public Shared Operator =(ByVal I1 As Interval, ByVal I2 As Interval) As Boolean
Return (I1.LowerBound = I2.LowerBound) And (I1.UpperBound = I2.UpperBound)
End Operator
Public Shared Operator <>(ByVal I1 As Interval, ByVal I2 As Interval) As Boolean
Return Not (I1 = I2)
End Operator
End Structure
Class IntervalComparer
Implements IComparer(Of Interval)
Public Function Compare(ByVal x As Interval, ByVal y As Interval) As Integer Implements System.Collections.Generic.IComparer(Of Interval).Compare
If x = y Then
Return 0
Else
If x.LowerBound > y.UpperBound Then
Return 1
ElseIf y.LowerBound > x.UpperBound Then
Return -1
End If
End If
End Function
End Class
Public Class FunctionDomain
Inherits List(Of Interval)
Private Shared DefaultComparer As New IntervalComparer()
Public Function IsInDomain(ByVal X As Double) As Boolean
If Me.Count = 0 Then
Return True
End If
Dim Result As Boolean = False
For Each I As Interval In Me
Result = Result Or I.IsXIncluded(X)
Next
Return Result
End Function
Public Function IsR() As Boolean
Return (Me.Count = 0) OrElse (Me.Count = 1 And Me(0) = Interval.R)
End Function
Public Shadows Sub Add(ByVal item As Interval)
For I As Int16 = 0 To Me.Count - 1
If Me(I).Intersects(item) Then
Me(I) = Interval.Union(Me(I), item)
Exit Sub
End If
Next
MyBase.Add(item)
End Sub
Public Function GetUndefinedIntervals(ByVal MainInterval As Interval) As Interval()
If Me.Count = 0 Then
Return New Interval() {}
End If
Me.Sort(DefaultComparer)
Dim Lower As Double = MainInterval.LowerBound
Dim Result As New List(Of Interval)
Dim Temp As Interval
For Each I As Interval In Me
If I.LowerBound > Lower Then
Temp = New Interval(Lower, I.LowerBound)
Result.Add(Temp)
End If
Lower = I.UpperBound
Next
If MainInterval.UpperBound > Lower Then
Temp = New Interval(Lower, MainInterval.UpperBound)
Result.Add(Temp)
End If
Return Result.ToArray()
End Function
End Class
Public Class [Function]
Public Enum RelationType
GraterThan
Equals
LessThan
End Enum
Private _Color As Color
Private _Expression As String
Private _RawExpression As String
Private _Type As RelationType
Private _Domain As FunctionDomain
Private _Name As String
Private Evaluator As Object
Public EvaluateFunction As MethodInfo
Public Property Color() As Color
Get
Return _Color
End Get
Set(ByVal value As Color)
_Color = value
End Set
End Property
Public Property Expression() As String
Get
Return _Expression
End Get
Set(ByVal value As String)
_Expression = value
Me.CreateEvaluator()
End Set
End Property
Public Property RawExpression() As String
Get
Return _RawExpression
End Get
Set(ByVal value As String)
_RawExpression = value
End Set
End Property
Public Property Type() As RelationType
Get
Return _Type
End Get
Set(ByVal value As RelationType)
_Type = value
End Set
End Property
Public Property Name() As String
Get
Return _Name
End Get
Set(ByVal value As String)
_Name = value
End Set
End Property
Public ReadOnly Property Domain() As FunctionDomain
Get
Return _Domain
End Get
End Property
Sub New()
_Domain = New FunctionDomain
Me.Color = Drawing.Color.Black
Me.Expression = "Return x"
Me.Type = RelationType.Equals
End Sub
Sub New(ByVal Type As RelationType, ByVal Expression As String)
_Domain = New FunctionDomain
Me.Color = Drawing.Color.Black
Me.Expression = Expression
Me.Type = Type
End Sub
Private Sub CreateEvaluator()
Dim Code As String = String.Format(My.Resources.EvaluatorCode, Me.Expression)
Dim Parameters As New CodeDom.Compiler.CompilerParameters
With Parameters
.GenerateExecutable = False
.TreatWarningsAsErrors = True
.TempFiles.KeepFiles = False
.GenerateInMemory = True
.ReferencedAssemblies.Add("Microsoft.VisualBasic.dll")
.ReferencedAssemblies.Add("System.dll")
End With
Dim Provider As New VBCodeProvider
Dim CompResults As CompilerResults = Provider.CompileAssemblyFromSource(Parameters, Code)
If CompResults.Errors.Count > 0 Then
Throw New FormatException("Espressione non valida!")
Else
Dim Asm As Reflection.Assembly = CompResults.CompiledAssembly
Me.Evaluator = Asm.CreateInstance("Evaluator")
Me.EvaluateFunction = Evaluator.GetType.GetMethod("Evaluate")
End If
End Sub
Public Sub ValidateExpression()
Dim Reader As New IO.StringReader(Me.RawExpression)
Dim Line, LineParts() As String
Dim Result As New System.Text.StringBuilder
Do
Line = Reader.ReadLine()
LineParts = Line.Split(":")
If LineParts.Count < 2 Then
Continue Do
End If
Parts.Add(LineParts(0).Trim(), LineParts(1).Trim())
If LineParts(0).Contains("allx") Then
Exit Do
End If
Loop While Reader.Peek > -1
Reader.Close()
Reader = Nothing
Line = Nothing
LineParts = Nothing
If Parts.ContainsKey("allx") Then
Result.AppendFormat("Return {0}", Parts("allx"))
Else
For Each Condition As String In Parts.Keys
Result.AppendFormat("If {0} Then : Return {1} : End If{2}", _
Condition, Parts(Condition), Environment.NewLine)
Next
End If
Me.Expression = Result.ToString()
Parts.Clear()
Parts = Nothing
Result = Nothing
End Sub
Public Function Apply(ByVal X As Double) As Double
Return EvaluateFunction.Invoke(Nothing, New Object() {X})
End Function
Public Function FindZero(ByVal IntervalLowerBound As Double, ByVal IntervalUpperBound As Double, ByVal Epsilon As Double) As Double?
Dim a, b, c As Double
Dim fa, fb, fc As Double
Dim Result, LastEpsilon As Double
a = IntervalLowerBound
b = IntervalUpperBound
If Me.Apply(a) * Me.Apply(b) > 0 Then
Return Nothing
End If
Do
c = (a + b) / 2
fa = Me.Apply(a)
fb = Me.Apply(b)
fc = Me.Apply(c)
If fa = 0 Then
c = a
Exit Do
End If
If fb = 0 Then
c = b
Exit Do
End If
If fc = 0 Then
Exit Do
End If
If fa * fc < 0 Then
b = c
Else
a = c
End If
If Math.Abs(a - b) = LastEpsilon Then
Exit Do
End If
LastEpsilon = Math.Abs(a - b)
Loop Until Math.Abs(a - b) < Epsilon
Result = c
Return Result
End Function
Public Overrides Function ToString() As String
Return String.Format("{0}(x)", Me.Name)
End Function
End Class
Public Class GraphCreator
Private _BackColor, _AxisColor, _GridColor As Color
Private _AxisThickness, _GridThickness, _FunctionThickness As Single
Private _XExtension, _YExtension As Interval
Private _XIncrement, _YIncrement As Double
Private _DrawValues, _DrawNonDefinitionIntervals As Boolean
Private _ValueDecimalPlaces As Int16
Private _Functions As List(Of [Function])
Private _OutputSize As Size
Private _Font As Font
Private _PixelSpan As Int16 = 2
<Browsable(True), _
DisplayName("Colore sfondo"), _
Description("Imposta il colore di sfondo del grafico.")> _
Public Property BackColor() As Color
Get
Return _BackColor
End Get
Set(ByVal Value As Color)
_BackColor = Value
End Set
End Property
<Browsable(True), _
DisplayName("Colore assi"), _
Description("Imposta il colore degli assi cartesiani.")> _
Public Property AxisColor() As Color
Get
Return _AxisColor
End Get
Set(ByVal Value As Color)
_AxisColor = Value
End Set
End Property
<Browsable(True), _
DisplayName("Colore griglia"), _
Description("Imposta il colore della griglia.")> _
Public Property GridColor() As Color
Get
Return _GridColor
End Get
Set(ByVal Value As Color)
_GridColor = Value
End Set
End Property
<Browsable(True), _
DisplayName("Spessore assi"), _
Description("Imposta lo spessore degli assi cartesiani.")> _
Public Property AxisThickness() As Single
Get
Return _AxisThickness
End Get
Set(ByVal Value As Single)
_AxisThickness = Value
End Set
End Property
<Browsable(True), _
DisplayName("Spessore griglia"), _
Description("Imposta lo spessore della griglia.")> _
Public Property GridThickness() As Single
Get
Return _GridThickness
End Get
Set(ByVal Value As Single)
_GridThickness = Value
End Set
End Property
<Browsable(True), _
DisplayName("Spessore funzioni"), _
Description("Imposta lo spessore della linea con cui vengono disegnate le funzioni.")> _
Public Property FunctionThickness() As Single
Get
Return _FunctionThickness
End Get
Set(ByVal value As Single)
_FunctionThickness = value
End Set
End Property
<Browsable(True), _
DisplayName("Intervallo X"), _
Description("Imposta l'intervallo di valori che il grafico mostra sull'asse X."), _
TypeConverter(GetType(IntervalConverter))> _
Public Property XExtension() As Interval
Get
Return _XExtension
End Get
Set(ByVal Value As Interval)
_XExtension = Value
End Set
End Property
<Browsable(True), _
DisplayName("Intervallo Y"), _
Description("Imposta l'intervallo di valori che il grafico mostra sull'asse Y."), _
TypeConverter(GetType(IntervalConverter))> _
Public Property YExtension() As Interval
Get
Return _YExtension
End Get
Set(ByVal Value As Interval)
_YExtension = Value
End Set
End Property
<Browsable(True), _
DisplayName("Griglia X"), _
Description("Indica ogni quanto disegnare la griglia verticale e i valori sull'asse X.")> _
Public Property XIncrement() As Double
Get
Return _XIncrement
End Get
Set(ByVal Value As Double)
_XIncrement = Value
End Set
End Property
<Browsable(True), _
DisplayName("Griglia Y"), _
Description("Indica ogni quanto disegnare la griglia orizzontale e i valori sull'asse Y.")> _
Public Property YIncrement() As Double
Get
Return _YIncrement
End Get
Set(ByVal Value As Double)
_YIncrement = Value
End Set
End Property
<Browsable(True), _
DisplayName("Valori"), _
Description("Indica se disegnare i valori sugli assi.")> _
Public Property DrawValues() As Boolean
Get
Return _DrawValues
End Get
Set(ByVal Value As Boolean)
_DrawValues = Value
End Set
End Property
<Browsable(True), _
DisplayName("Limitazioni"), _
Description("Determina se tratteggiare le zone del grafico in cui la funzione non è definita.")> _
Public Property DrawNonDefinitionIntervals() As Boolean
Get
Return _DrawNonDefinitionIntervals
End Get
Set(ByVal value As Boolean)
_DrawNonDefinitionIntervals = value
End Set
End Property
<Browsable(True), _
DisplayName("Cifre decimali"), _
Description("Imposta il numero di cifre decimali visualizzate dai valori sugli assi.")> _
Public Property ValueDecimalPlaces() As Int16
Get
Return _ValueDecimalPlaces
End Get
Set(ByVal value As Int16)
_ValueDecimalPlaces = value
End Set
End Property
<Browsable(True), _
DisplayName("Dimensione grafico"), _
Description("Imposta le dimensioni del grafico, in pixel.")> _
Public Property OutputSize() As Size
Get
Return _OutputSize
End Get
Set(ByVal value As Size)
_OutputSize = value
End Set
End Property
<Browsable(True), _
DisplayName("Font"), _
Description("Imposta il font da utilizzare per disegnare i valori e le etichette.")> _
Public Property Font() As Font
Get
Return _Font
End Get
Set(ByVal value As Font)
_Font = value
End Set
End Property
<Browsable(True), _
DisplayName("Precisione"), _
Description("La funzione viene calcolata per punti, ma il numero di pixel disponibile è limitato. Questo numero indica ogni quanti pixel ricalcolare i valori della funzione.")> _
Public Property PixelSpan() As Int16
Get
Return _PixelSpan
End Get
Set(ByVal value As Int16)
_PixelSpan = value
End Set
End Property
<Browsable(False)> _
Public ReadOnly Property Functions() As List(Of [Function])
Get
Return _Functions
End Get
End Property
Private ReadOnly Property IsYAxisVisible() As Boolean
Get
Return (Me.XExtension.LowerBound <= 0 And Me.XExtension.UpperBound >= 0)
End Get
End Property
Private ReadOnly Property IsXAxisVisible() As Boolean
Get
Return (Me.YExtension.LowerBound <= 0 And Me.YExtension.UpperBound >= 0)
End Get
End Property
Private ReadOnly Property IsOriginVisible() As Boolean
Get
Return (Me.IsYAxisVisible) And (Me.IsXAxisVisible)
End Get
End Property
Private ReadOnly Property Origin() As Point
Get
Return New Point(Me.OutputSize.Width * (0 - Me.XExtension.LowerBound) / Me.XExtension.Length, _
CInt(Me.OutputSize.Height * (Me.YExtension.UpperBound - 0) / Me.YExtension.Length))
End Get
End Property
Sub New()
Me.BackColor = Color.White
Me.AxisColor = Color.Black
Me.GridColor = Color.Gainsboro
Me.AxisThickness = 1
Me.GridThickness = 1
Me.FunctionThickness = 1
Me.XExtension = New Interval(-20, 20)
Me.YExtension = New Interval(-15, 15)
Me.XIncrement = 1
Me.YIncrement = 1
Me.OutputSize = New Size(800, 600)
Me.Font = New Font("Microsoft Sans Serif", 12, FontStyle.Regular)
_Functions = New List(Of [Function])
End Sub
Public Function CreateGraph() As Bitmap
Dim Result As New Bitmap(Me.OutputSize.Width, Me.OutputSize.Height)
Dim G As Graphics = Graphics.FromImage(Result)
Dim GridPen As New Pen(Me.GridColor, Me.GridThickness)
Dim AxisPen As New Pen(Me.AxisColor, Me.AxisThickness)
Dim AxisBrush As New SolidBrush(Me.AxisColor)
Dim O As Point
O = Me.Origin
G.SmoothingMode = Drawing2D.SmoothingMode.AntiAlias
G.Clear(Me.BackColor)
'Griglia verticale
Dim Px As Int32
For Ix As Double = Me.XExtension.LowerBound To Me.XExtension.UpperBound Step Me.XIncrement
Px = CInt(Me.OutputSize.Width * (Ix - Me.XExtension.LowerBound) / Me.XExtension.Length)
G.DrawLine(GridPen, Px, 0, Px, Me.OutputSize.Height + 1)
If (Me.DrawValues) And (Me.IsXAxisVisible) Then
Dim Val As String = String.Format("{0:N" & Me.ValueDecimalPlaces & "}", Ix)
Dim ValSize As SizeF = G.MeasureString(Val, Me.Font)
G.DrawLine(AxisPen, Px, O.Y, Px, O.Y + 3)
G.DrawString(Val, Me.Font, AxisBrush, Px - ValSize.Width / 2, O.Y + 5)
End If
Next
'Griglia orizzontale
Dim Py As Int32
For Iy As Double = Me.YExtension.LowerBound To Me.YExtension.UpperBound Step Me.YIncrement
Py = CInt(Me.OutputSize.Height * (Me.YExtension.UpperBound - Iy) / Me.YExtension.Length)
G.DrawLine(GridPen, 0, Py, Me.OutputSize.Width + 1, Py)
If (Me.DrawValues) And (Me.IsYAxisVisible) Then
Dim Val As String = String.Format("{0:N" & Me.ValueDecimalPlaces & "}", Iy)
Dim ValSize As SizeF = G.MeasureString(Val, Me.Font)
G.DrawLine(AxisPen, O.X, Py, O.X - 3, Py)
G.DrawString(Val, Me.Font, AxisBrush, O.X - 5 - ValSize.Width, Py - ValSize.Height / 2)
End If
Next
'Asse Y
If Me.IsYAxisVisible Then
G.DrawLine(AxisPen, O.X, 0, O.X, Me.OutputSize.Height + 1)
End If
'Asse X
If Me.IsXAxisVisible Then
G.DrawLine(AxisPen, 0, O.Y, Me.OutputSize.Width + 1, O.Y)
End If
Dim Points As New List(Of Point)
Dim Y As Double
Dim XEpsilon As Double = Me.PixelSpan * Me.XExtension.Length / Me.OutputSize.Width
For Each F As [Function] In Me.Functions
If Me.DrawNonDefinitionIntervals Then
For Each I As Interval In F.Domain.GetUndefinedIntervals(Me.XExtension)
G.FillRectangle(New Drawing2D.HatchBrush(Drawing2D.HatchStyle.BackwardDiagonal, Color.FromArgb(125, F.Color), Color.Transparent), _
CInt(Me.OutputSize.Width * (I.LowerBound - Me.XExtension.LowerBound) / Me.XExtension.Length), _
0, CInt(Me.OutputSize.Width * I.Length / Me.XExtension.Length), Me.OutputSize.Height + 1)
Next
End If
For X As Double = Me.XExtension.LowerBound To Me.XExtension.UpperBound Step (Me.PixelSpan * Me.XExtension.Length / Me.OutputSize.Width)
Try
If Not F.Domain.IsInDomain(X) Then
If Points.Count > 0 Then
G.DrawCurve(New Pen(F.Color, Me.FunctionThickness), Points.ToArray)
Points.Clear()
End If
Continue For
End If
Y = F.Apply(X)
Points.Add(New Point( _
Me.OutputSize.Width * (X - Me.XExtension.LowerBound) / Me.XExtension.Length, _
Me.OutputSize.Height * (Me.YExtension.UpperBound - Y) / Me.YExtension.Length))
Catch Ex As Exception
End Try
Next
If Points.Count > 0 Then
Try
G.DrawCurve(New Pen(F.Color, Me.FunctionThickness), Points.ToArray)
Catch Ex As Exception
End Try
If F.Type = [Function].RelationType.GraterThan Then
Dim P As New Drawing2D.GraphicsPath()
Points.Add(New Point(Me.OutputSize.Width, 0))
Points.Add(New Point(0, 0))
P.AddCurve(Points.ToArray)
P.CloseFigure()
G.FillPath(New SolidBrush(Color.FromArgb(50, F.Color.R, F.Color.G, F.Color.B)), P)
End If
If F.Type = [Function].RelationType.LessThan Then
Dim P As New Drawing2D.GraphicsPath()
Points.Add(New Point(Me.OutputSize.Width, Me.OutputSize.Height))
Points.Add(New Point(0, Me.OutputSize.Height))
P.AddCurve(Points.ToArray)
P.CloseFigure()
G.FillPath(New SolidBrush(Color.FromArgb(50, F.Color.R, F.Color.G, F.Color.B)), P)
End If
End If
Points.Clear()
Next
Return Result
End Function
End Class