Add lambda to predicate - VB.NET - vb.net

I have the above code :
if (i=0)
pred = (Function(d) d.n_pratica = n_pratica)
else
pred = (Function(d) d.n_polizza = n_polizza)
i need to add to pred another lambda expression to the one that just exists :
(Function(d) d.n_anagrafico = n_anagrafico) //this function is in another if statement so i can't add it directly to the stametent wrote before.
So if i=0
the result need to be
pred = (Function(d) d.n_pratica = n_pratica andalso d.n_anagrafico = n_anagrafico)
else
pred = (Function(d) d.n_polizza= n_polizza andalso d.n_anagrafico = n_anagrafico)
"Pred" is a Func (of object , boolean).
Thanks

This code should help:
Sub Main
Dim n_pratica As String = "Foo"
Dim n_anagrafico As String = "Bar"
Dim pred As Func(Of SomeClass, Boolean) = Function (d) d.n_pratica = n_pratica
Dim pred_original = pred
pred = Function (d) pred_original(d) AndAlso d.n_anagrafico = n_anagrafico
Dim sc = New SomeClass()
sc.n_pratica = n_pratica
sc.n_anagrafico = n_anagrafico
Console.WriteLine(pred(sc))
sc.n_pratica = "Qaz"
Console.WriteLine(pred(sc))
End Sub
Public Class SomeClass
Public n_pratica As String
Public n_anagrafico As String
End Class
It outputs True then False.
As a word of advice - please ensure that you always have Option Strict On for all of your VB coding.

Related

Sample code of aleaGPU is not working in VB

C# code:
[GpuManaged, Test]
public static void ActionFactoryWithClosure2()
{
var MyGPU = Gpu.Get(0);
var arg1 = Enumerable.Range(0, Length).ToArray();
var arg2 = Enumerable.Range(0, Length).ToArray();
var result = new int[Length];
Func<int[], Action<int>> opFactory = res => i =>
{
res[i] = arg1[i] + arg2[i];
};
MyGPU.For(0, arg1.Length, opFactory(result));
}
VB.NET code:
<GpuManaged>
Public Shared Function GPU_TEST_VB_20170920()
Dim MyGPU As Alea.Gpu = Gpu.Default
Dim arg1 = Enumerable.Range(0, Length).ToArray()
Dim arg2 = Enumerable.Range(0, Length).ToArray()
Dim result = New Integer(Length - 1) {}
Dim expected = New Integer(Length - 1) {}
Dim opFactory As Func(Of Integer(), Action(Of Integer)) = Function(res) Function(i)
res(i) = arg1(i) + arg2(i)
End Function
Dim op As Action(Of Integer) = Function(i) InlineAssignHelper(result(i), arg1(i) + arg2(i))
Dim op2 As Action(Of Integer) = Sub(i)
result(i) = arg1(i) + arg2(i)
End Sub
MyGPU.[For](0, result.Length, Function(i) InlineAssignHelper(result(i), arg1(i) + arg2(i))) 'Error : The given key was not present in the dictionary.
MyGPU.For(0, arg1.Length, opFactory(result)) 'Error : The given key was not present in the dictionary.
MyGPU.For(0, arg1.Length, op) 'Error : The given key was not present in the dictionary.
MyGPU.For(0, arg1.Length, op2) 'Error : Cannot get field ""$VB$Local_result. Possible reasons: -> Static field Is Not supported."
End Sub
In case of C#, I can run sample code, but in VB, I Got error message (please see above code lines)
What Should I Do
Same condition : VS 2017, Windows 10, AleaGPU 3.0.3

Property in object not updating

When I use the following code to create my object, the values I assign in the with portion does no reflect in my class, and I am trying to use that values in the Sub New() portion which is in the 2nd snippet. How can I make that work?
Dim RoughPnl As New RoughPnl(trvPartList, pnlBasePanel, chkRoughUnderFinal.Checked) With
{.Material = cboMaterial.Text, .Label = cboLabel.Text, .Qty = cboQty.Text,
.BoardThickness = cboThickness.Text,
.BoardWidth = cboWidth.Text,
.BoardLength = cboLength.Text,
.BoardColor = picFinalColor.Tag,
.BoardImage = picFinalColor.Image,
.DimLinesON = chkFinalDimLines.Checked,
.LabelsON = chkLabelsON.Checked,
.SizeON = chkSizeON.Checked}
2nd Snippet
Public NotInheritable Class RoughPnl
Inherits MyPanel
Sub New(objTree As TreeView, basePnl As Panel, rpnl As boolean)
MyBase.New(objTree, basePnl)
'Initial values
m_myKey = myKey
m_refNum = refNum
m_material = material
m_label = label
m_qty = qty
m_pnlID = "Rough"
Me.Name = m_pnlID & "key" & m_material & "-" & m_myKey
End Sub
End Class
As suggested by #GlorinOakenfoot, code like this:
Dim obj As New SomeType With {.SomeProperty = someValue}
Is just a shorthand for this:
Dim obj As New SomeType
obj.SomeProperty = someValue
It should be obvious why you can't use someValue in the constructor. If you want to use a value in the constructor then, like for any other method, you must pas that value via a parameter.

Call a different string method based on a flag in VB.NET

I want to be able to call a different String method based on what is passed in a parameter. For example, my parameter is "%XYZ%". If there are percent signs on both sides of XYZ, further down in code I want to say SomeString.Contains("XYZ").
If there is a percent sign only on the left of XYZ, further down in code I want to say
SomeString.EndsWith("XYZ").
Ideally, I want something like this:
With objSearchTerms
If Not String.IsNullOrEmpty(.ProjectName) Then
If .ProjectName.StartsWith("%") AndAlso .ProjectName.EndsWith("%") Then
'MyStringMethod = Contains
ElseIf .ProjectName.EndsWith("%") Then
'MyStringMethod = StartsWith
ElseIf .ProjectName.StartsWith("%") Then
'MyStringMethod = EndsWith
Else
'MyStringMethod = Equals
End If
End If
End With
Then further down I want to be able to say:
filingList = filingRepository.GetList (Function(e) e.SERFFTrackingToFilings.Any(Function(x) x.SERFFTracking.Number.*MyStringMethod*(objTerms.TrackingNumber))
Thank you.
If you had a reference to the string that you want to run the method on, then you could assign the method to a Func<T, TResult> delegate, and invoke the delegate, something like.
Dim MyStringMethod As Func(Of String, Boolean)
'...
MyStringMethod = AddressOf(SomeString.Contains)
'...
Dim result As Boolean = MyStringMethod(SomeOtherString) 'SomeString.Contains(SomeOtherString)
But it looks like your SomeString is in an anonymous function where you may not already have a reference to it. Possible workaround:
Dim MyStringMethod As Func(Of String, String, Boolean)
'...if...
MyStringMethod = Function(a As String, b As String) a.Contains(b)
'...else if...
MyStringMethod = Function(a As String, b As String) a.StartsWith(b)
'...etc.
filingList = filingRepository.GetList (Function(e) e.SERFFTrackingToFilings.Any(Function(x) MyStringMethod(x.SERFFTracking.Number, objTerms.TrackingNumber)))
I ended up doing the following:
I created a Module:
Module StringExtensions
<Extension()>
Public Function ProcessString(ByVal strToCheck As String, ByVal strOperand As String, ByVal strWhatTocheck As String) As Boolean
Select Case strOperand
Case "Contains"
Return strToCheck.Trim.ToUpper.Contains(strWhatTocheck.Trim.ToUpper)
Case "StartsWith"
Return strToCheck.Trim.ToUpper.StartsWith(strWhatTocheck.Trim.ToUpper)
Case "EndsWith"
Return strToCheck.Trim.ToUpper.Contains(strWhatTocheck.Trim.ToUpper)
Case "Equals"
Return strToCheck.Trim.ToUpper.Equals(strWhatTocheck.Trim.ToUpper)
Case Else
Throw New ApplicationException("Can't match ProcessString(). ")
End Select
End Function
End Module
Then in the calling method I used the module like this:
Dim filingListDTO As New List(Of DTO.FilingDetailsViewModel)
Dim strNumberOperand As String = ""
Dim strProjectNumber As String = ""
With model
If Not String.IsNullOrEmpty(.ProjectNumber) Then
If .ProjectNumber.StartsWith("%") AndAlso .ProjectNumber.EndsWith("%") Then
strNumberOperand = "Contains"
ElseIf .ProjectNumber.EndsWith("%") Then
strNumberOperand = "StartsWith"
ElseIf .ProjectNumber.StartsWith("%") Then
strNumberOperand = "EndsWith"
Else
strNumberOperand = "Equals"
End If
strProjectNumber = .ProjectNumber.Replace("%", "").Trim.ToUpper
.ProjectNumber = strProjectNumber
End If
End With
filingListDTO = (From f In <<someList>>
Where f.ProjectNumber.ProcessString(strNumberOperand, strProjectNumber) _
Select f).ToList

How to compare 2 JSON structures using VB.NET?

I am new to JSON.NET. I am trying to compare 2 JSON structures using VB.NET like
{
"attrs":[
{
"name":"_DB_ATTR_OSD_PARENT_",
"column":"OsDeployerParent",
"type":"Integer",
"enumName":null
},
{
"name":"_DB_ATTR_SMALLICON_",
"column":"CurrentSmallIcon",
"type":"Enum"
}
]
}
Please can someone help me.
Thanks.
classes to be used
public class testObjects
{
public List<testObject> attrs;
}
public class testObject
{
public string name;
public string column;
public string type;
public string enumName;
}
Comparison preparing for class
class ObjectComparer : EqualityComparer<testObject>
{
public override bool Equals(testObject c1, testObject c2)
{
if (c1.name == c2.name &&
c1.column == c2.column &&
c1.enumName == c2.enumName &&
c1.type == c2.type)
{
return true;
}
else
{
return false;
}
}
public override int GetHashCode(testObject c)
{
int hash = 23;
if (c.name != null) hash = hash * 37 + c.name.GetHashCode();
if (c.column != null) hash = hash * 37 + c.column.GetHashCode();
if (c.enumName != null) hash = hash * 37 + c.enumName.GetHashCode();
if (c.type != null) hash = hash * 37 + c.type.GetHashCode();
return hash;
}
}
operations starts right here
string jsonObjects = #"{ 'attrs':[ { 'name':'_DB_ATTR_OSD_PARENT_', 'column':'OsDeployerParent', 'type':'Integer', 'enumName':null }, { 'name':'_DB_ATTR_SMALLICON_', 'column':'CurrentSmallIcon', 'type':'Enum' } ] }";
System.Web.Script.Serialization.JavaScriptSerializer js = new System.Web.Script.Serialization.JavaScriptSerializer();
var objects = js.Deserialize(jsonObjects, typeof(testObjects));
ObjectComparer cmp = new ObjectComparer();
testObjects deserializedObject = ((testObjects)objects);
// this allows you to remove double entries
var distinctObjects = deserializedObject.attrs.Distinct(cmp).ToList();
Console.WriteLine(string.Format("duplicate objects count : {0}", (deserializedObject.attrs.Count - distinctObjects.Count).ToString()));
//If you want to compare if the following code can be used individually
testObject obj1 = ((testObjects)objects).attrs.First();
testObject obj2 = ((testObjects)objects).attrs.Skip(1).First();
bool isObjectEquals = cmp.Equals(obj1, obj2);
Console.WriteLine(string.Format("Objects are {0}", isObjectEquals ? "Equals" : "Not Equals"));
this is vb code
classes to be used
Public Class testObjects
Public attrs As List(Of testObject)
End Class
Public Class testObject
Public name As String
Public column As String
Public type As String
Public enumName As String
End Class
Comparison preparing for class
Class ObjectComparer
Inherits EqualityComparer(Of testObject)
Public Overrides Function Equals(c1 As testObject, c2 As testObject) As Boolean
If c1.name = c2.name AndAlso c1.column = c2.column AndAlso c1.enumName = c2.enumName AndAlso c1.type = c2.type Then
Return True
Else
Return False
End If
End Function
Public Overrides Function GetHashCode(c As testObject) As Integer
Dim hash As Integer = 23
If c.name IsNot Nothing Then
hash = hash * 37 + c.name.GetHashCode()
End If
If c.column IsNot Nothing Then
hash = hash * 37 + c.column.GetHashCode()
End If
If c.enumName IsNot Nothing Then
hash = hash * 37 + c.enumName.GetHashCode()
End If
If c.type IsNot Nothing Then
hash = hash * 37 + c.type.GetHashCode()
End If
Return hash
End Function
End Class
operations starts right here
Dim jsonObjects As String = "{ 'attrs':[ { 'name':'_DB_ATTR_OSD_PARENT_', 'column':'OsDeployerParent', 'type':'Integer', 'enumName':null }, { 'name':'_DB_ATTR_SMALLICON_', 'column':'CurrentSmallIcon', 'type':'Enum' } ] }"
Dim js As New System.Web.Script.Serialization.JavaScriptSerializer()
Dim objects = js.Deserialize(jsonObjects, GetType(testObjects))
Dim cmp As New ObjectComparer()
Dim deserializedObject As testObjects = DirectCast(objects, testObjects)
' this allows you to remove double entries
Dim distinctObjects = deserializedObject.attrs.Distinct(cmp).ToList()
Console.WriteLine(String.Format("duplicate objects count : {0}", (deserializedObject.attrs.Count - distinctObjects.Count).ToString()))
'If you want to compare if the following code can be used individually
Dim obj1 As testObject = DirectCast(objects, testObjects).attrs.First()
Dim obj2 As testObject = DirectCast(objects, testObjects).attrs.Skip(1).First()
Dim isObjectEquals As Boolean = cmp.Equals(obj1, obj2)
Console.WriteLine(String.Format("Objects are {0}", If(isObjectEquals, "Equals", "Not Equals")))
New Codes
string jsonObjects = #"{ 'attrs':[ { 'name':'_DB_ATTR_OSD_PARENT_', 'column':'OsDeployerParent', 'type':'Integer', 'enumName':null }, { 'name':'_DB_ATTR_SMALLICON_', 'column':'CurrentSmallIcon', 'type':'Enum' } ] }";
string jsonObjects2 = #"{ 'attrs':[ { 'name':'_DB_ATTR_OSD_PARENT_', 'column':'OsDeployerParent1', 'type':'Integer', 'enumName':null }, { 'name':'_DB_ATTR_SMALLICON_', 'column':'CurrentSmallIcon', 'type':'Enum' } ] }";
System.Web.Script.Serialization.JavaScriptSerializer js = new System.Web.Script.Serialization.JavaScriptSerializer();
var objects = js.Deserialize(jsonObjects, typeof(testObjects));
var objects2 = js.Deserialize(jsonObjects2, typeof(testObjects));
ObjectComparer2 cmp = new ObjectComparer2();
testObjects deserializedObject = ((testObjects)objects);
testObjects deserializedObject2 = ((testObjects)objects2);
bool isObjectEquals = cmp.Equals(deserializedObject, deserializedObject2);
Console.WriteLine(string.Format("Objects are {0}", isObjectEquals ? "Equals" : "Not Equals"));
Class ObjectComparer
Inherits EqualityComparer(Of testObject)
Public Overrides Function Equals(c1 As testObject, c2 As testObject) As Boolean
If c1.name = c2.name AndAlso c1.column = c2.column AndAlso c1.enumName = c2.enumName AndAlso c1.type = c2.type Then
Return True
Else
Return False
End If
End Function
Public Overrides Function GetHashCode(c As testObject) As Integer
Dim hash As Integer = 23
If c.name IsNot Nothing Then
hash = hash * 37 + c.name.GetHashCode()
End If
If c.column IsNot Nothing Then
hash = hash * 37 + c.column.GetHashCode()
End If
If c.enumName IsNot Nothing Then
hash = hash * 37 + c.enumName.GetHashCode()
End If
If c.type IsNot Nothing Then
hash = hash * 37 + c.type.GetHashCode()
End If
Return hash
End Function
End Class
Class ObjectComparer2
Inherits EqualityComparer(Of testObjects)
Public Overrides Function Equals(c1 As testObjects, c2 As testObjects) As Boolean
Dim cmp As New ObjectComparer()
For Each obj1 As testObject In c1.attrs
If Not c2.attrs.Any(Function(x) cmp.Equals(x, obj1)) Then
Return False
End If
Next
Return True
End Function
Public Overrides Function GetHashCode(c As testObjects) As Integer
Dim hash As Integer = 23
For Each obj As testObject In c.attrs
hash += obj.GetHashCode()
Next
Return hash
End Function
End Class

Parsing latin plant names with piglet fluent configuration

I have the following tests.And Classes. Now I just need to find how to write the rules and it seemed so simple ;-). But I'm going nowhere fast. As the tags say, I would like to use and learn piglet for this.
Public Class Plant
Public Property Genus As String
Public Property Species As String
Public Property SubSpecies As String
Public Property IsHybrid As Boolean
End Class
Public Class ParserTests
<Test>
Public Sub IfGenusCanBeFoundWhenOnlyGenusAndSpiecesAreThere()
Dim parser = New ParseLatinPlantName
Dim result = parser.Parse("Salvia sylvatica")
Assert.AreEqual("Salvia", result.Genus)
End Sub
<Test>
Public Sub IfSpeciesCanBeFoundWhenOnlyGenusAndSpiecesAreThere()
Dim parser = New ParseLatinPlantName
Dim result = parser.Parse("Salvia sylvatica")
Assert.AreEqual("sylvatica", result.Species)
End Sub
<Test>
Public Sub IfSubSpeciesCanBeFoundWhenSubSpeciesIsProvided()
Dim parser = New ParseLatinPlantName
Dim result = parser.Parse("Salvia sylvatica sp. crimsonii")
Assert.AreEqual("crimsonii", result.SubSpecies)
End Sub
<Test>
Public Sub IfIsHybridIsTrueWhenxIsInNameCanBeFoundWhenSubSpeciesIsProvided()
Dim parser = New ParseLatinPlantName
Dim result = parser.Parse("Salvia x jamensis")
Assert.IsTrue(result.IsHybrid)
End Sub
End Class
And here is what I tried so far.
Public Class ParseLatinPlantName
Public Function Parse(ByVal name As String) As Plant
Dim config = ParserFactory.Fluent()
Dim expr = config.Rule()
Dim name1 = config.Expression()
name1.ThatMatches("[a-z]+").AndReturns(Function(f) f)
Dim space1 = config.Expression()
space1.ThatMatches(" ").AndReturns(Function(f) f)
expr.IsMadeUp.By(name).As("Genus").Followed.By(name).As("Species").WhenFound(Function(f) New Plant With {.Genus = f.Genus})
Dim parser = config.CreateParser()
Dim result = DirectCast(parser.Parse(name), Plant)
Return result
End Function
End Class
Update
I got the first two tests passing thanks to Randompunter.
Public Class ParseLatinPlantName
Public Function Parse(ByVal name As String) As Plant
Dim config = ParserFactory.Fluent()
Dim expr = config.Rule()
Dim name1 = config.Expression()
name1.ThatMatches("\w+").AndReturns(Function(f) f)
expr.IsMadeUp.By(name1).As("Genus") _
.Followed.By(name1).As("Species") _
.WhenFound(Function(f) New Plant With {.Genus = f.Genus, .Species = f.Species})
Dim parser = config.CreateParser()
Dim result = DirectCast(parser.Parse(name), Plant)
Return result
End Function
End Class
Firstly, your original (then corrected expression matched only lowercase letters). This was corrected by changing it to \w+ which matched any other letter.
You second two tests failed because your grammar does not allow for more than two following letters. You will need to add a rule to make this work.
For instance, you have an example where a subspecies is provided. Assume that this takes the form where .sp xxx is an optional thing to pass, a separate rule needs to provided for this.
This passes the test for an optional subspecies
Public Class ParseLatinPlantName
Public Function Parse(ByVal name As String) As Plant
Dim config = ParserFactory.Fluent()
Dim expr = config.Rule()
Dim subSpecies = config.Rule()
Dim sp = config.Expression()
sp.ThatMatches("sp\.").AndReturns(Function(f) f)
Dim name1 = config.Expression()
name1.ThatMatches("\w+").AndReturns(Function(f) f)
Dim nothing1 = config.Rule()
expr.IsMadeUp.By(name1).As("Genus") _
.Followed.By(name1).As("Species") _
.Followed.By(subSpecies).As("Subspecies") _
.WhenFound(Function(f) New Plant With {.Genus = f.Genus, .Species = f.Species, .SubSpecies = f.Subspecies})
subSpecies.IsMadeUp.By(sp).Followed.By(name1).As("Subspecies").WhenFound(Function(f) f.Subspecies) _
.Or.By(nothing1)
Dim parser = config.CreateParser()
Dim result = DirectCast(parser.Parse(name), Plant)
Return result
End Function
End Class
Excuse my probably extremely shoddy VB, it was ages ago. Note that there is an expression that explicitly matches "sp." to distinguish it from any other type of name. This rule is then also matched by another rule that matches nothing. This enables the subspecies part to be optional.
I'm not to sure what you want parsed from the hybrid rule. I assume it must be something with name followed by an x and followed by some other name then it is a hybrid. To match this, add another rule to your parser.
The following parser passes all of your tests:
Public Class ParseLatinPlantName
Public Function Parse(ByVal name As String) As Plant
Dim config = ParserFactory.Fluent()
Dim expr = config.Rule()
Dim subSpecies = config.Rule()
Dim hybridIndicator = config.Expression
hybridIndicator.ThatMatches("x").AndReturns(Function(f) f)
Dim sp = config.Expression()
sp.ThatMatches("sp\.").AndReturns(Function(f) f)
Dim name1 = config.Expression()
name1.ThatMatches("\w+").AndReturns(Function(f) f)
Dim nothing1 = config.Rule()
expr.IsMadeUp.By(name1).As("Genus") _
.Followed.By(name1).As("Species") _
.Followed.By(subSpecies).As("Subspecies") _
.WhenFound(Function(f) New Plant With {.Genus = f.Genus, .Species = f.Species, .SubSpecies = f.Subspecies}) _
.Or.By(name1).As("FirstSpecies").Followed.By(hybridIndicator).Followed.By(name1).As("SecondSpecies") _
.WhenFound(Function(f) New Plant With {.IsHybrid = True})
subSpecies.IsMadeUp.By(sp).Followed.By(name1).As("Subspecies").WhenFound(Function(f) f.Subspecies) _
.Or.By(nothing1)
Dim parser = config.CreateParser()
Dim result = DirectCast(parser.Parse(name), Plant)
Return result
End Function
End Class
It is important that your expressions if they overlap are declared in the order of precedence. If you were to declare name1 before hybridIndicator the x would be recognized as a name, causing the parsing to fail. And as you probably noticed, Piglet ignores whitespace by default, there is no need to make a rule for it. If this setting is not desired, there is an option to turn it off in the configurator. (use the Ignore method)