Matching Values
-
Here is the C# version of Vasc's logic. Just load the data int Datatable dt before calling this function. Sort Order = "Value DESC"
private string FindValues(int ColPos, double Value)
{
string TempResult = "";
double SumValue = 0;
double NewValue = 0;
bool FoundVal = false;
int MaxPos = dt.Rows.Count - 1;
for (int ii = ColPos; ii >= 0 ; ii--)
{
SumValue = SumValue + Convert.ToDouble(dt.DefaultView[MaxPos - ii].Row["Value"].ToString());
}
if (Value > SumValue)
{
return " ";
}
//check to see if a number matches myValue
for (int ii = ColPos; ii >= 0; ii--)
{
if(Convert.ToDouble(dt.DefaultView[MaxPos - ii].Row["Value"].ToString()) == Value)
{
return Value.ToString();
}
}
//if no Value was found then iterate trough table until the Value in table is less than MyValue
for (int ii = ColPos; ii >= 0; ii--)
{
if(Convert.ToDouble(dt.DefaultView[MaxPos - ii].Row["Value"].ToString()) <= Value)
{
ColPos = ii;
FoundVal = true;
break;
}
}
if (!FoundVal)
{
return " ";
}
while (ColPos > 0)
{
NewValue = Convert.ToDouble(dt.DefaultView[MaxPos - ColPos].Row["Value"].ToString());
ColPos = ColPos - 1;
TempResult = FindValues(ColPos, Value - NewValue);
if(TempResult.Trim() != "")
{
TempResult = NewValue.ToString().Trim() + newLine() + TempResult.Trim();
return TempResult;
}
}
return " ";
}
private string newLine()
{
return ((char)13).ToString() + ((char)10).ToString();
}
Regards,
gova -
Thanks, I am still using Visual Studio 6.0 and have not changed to C#. But I should be able to translate this to either c++ or VB.
Mike
-
I will post VB code tomorrow morning. It will be the same like C# with little change.
Regards,
gova -
With some tunning this VB code is WAY faster than the Recursive solution( try 219,339,439 wich are really time consummers values for the recursive version)
Dim ArrayValues() As Double
Dim MyStack() As Integer
Dim Sol() As Double
Private Sub Command1_Click()
Dim val As Double
Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim High As Double
Dim Low As Double
Dim Found As Boolean
Dim count As Integer
Dim AllSum As Double
AllSum = 0
count = 0
Found = False
cn.CursorLocation = adUseClient
cn.Provider = "SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;Initial Catalog=test1;Data Source=ITWSVK01"
cn.Open
val = CDbl(Text1.Text)
rs.Open "select value From MyTable WHERE Value<=" + Str(val) + " order by Value", cn
While Not rs.EOF
count = count + 1
ReDim Preserve ArrayValues(count)
ArrayValues(count) = rs!Value
AllSum = AllSum + ArrayValues(count)
rs.MoveNext
Wend
Set rs = Nothing
cn.Close
Set cn = Nothing
If count = 0 Then
MsgBox "The value is smaller than the lowest value in the table" _
, vbOKOnly, "Error"
Exit Sub
End If
Dim MyElem As Double
Dim MySol As String
Dim cntSOl As Integer
Dim cntStack As Integer
cntStack = 0
mm = UBound(ArrayValues)
For ii = 1 To mm
cntStack = cntStack + 1
ReDim Preserve MyStack(cntStack)
MyStack(cntStack) = ii
Next ii
ReDim Preserve Sol(0)
While UBound(MyStack) > 0
MyElem = MyStack(UBound(MyStack))
If MyElem = Sol(UBound(Sol)) Then
ReDim Preserve MyStack(UBound(MyStack) - 1)
ReDim Preserve Sol(UBound(Sol) - 1)
val = val + ArrayValues(MyElem)
AllSum = AllSum + ArrayValues(MyElem)
If UBound(Sol) = 1 Then AllSum = AllSum - ArrayValues(MyElem)
Else
cntSOl = UBound(Sol)
cntSOl = cntSOl + 1
ReDim Preserve Sol(cntSOl)
Sol(cntSOl) = MyElem
val = val - ArrayValues(MyElem)
AllSum = AllSum - ArrayValues(MyElem)
If val = 0 Then
For jj = 1 To UBound(Sol)
MySol = MySol + Str(ArrayValues(Sol(jj)))
Next jj
MsgBox MySol
Exit Sub
Else
If AllSum >= val Then
'check to see if the value is in the remaining values
For rr = MyElem - 1 To 1 Step -1
If val = ArrayValues(rr) Then
For jj1 = 1 To UBound(Sol)
MySol = MySol + Str(ArrayValues(Sol(jj1)))
Next jj1
MsgBox MySol + " " + Str(val)
Exit Sub
End If
Next rr
While ArrayValues(MyElem) > val
MyElem = MyElem - 1
Wend
If MyElem > 1 Then
For kk = 1 To MyElem - 1
ReDim Preserve MyStack(UBound(MyStack) + 1)
MyStack(UBound(MyStack)) = kk
Next kk
End If
End If
End If
End If
Wend
MsgBox "notfound"
End Sub
Kindest Regards,Vasc
-
I will post VB code tomorrow morning. It will be the same like C# with little change.
Regards,
gova -
'Vasc's Logic in VB (VIsual Studio 6.0)
'Save the following code (Exclude these red lines) as frmMatchValues.frm.
'Then Open the file with VS 6.0. Don't forget add MicrosoftActivex data objects reference.
'This will work without database connection. For solution from database get rs from DB.
'Vasc you can see your logic like a copy paste in my VB Code.
'I like VB since this my best known language
VERSION 5.00
Begin VB.Form frmMatchValues
Caption = "MatchValues"
ClientHeight = 8580
ClientLeft = 60
ClientTop = 345
ClientWidth = 9660
LinkTopic = "Form1"
ScaleHeight = 8580
ScaleWidth = 9660
StartUpPosition = 3 'Windows Default
Begin VB.CommandButton cmdFind
Caption = "Find"
Height = 375
Left = 6120
TabIndex = 6
Top = 1080
Width = 855
End
Begin VB.TextBox txtFind
Height = 375
Left = 4320
TabIndex = 5
Top = 1080
Width = 1815
End
Begin VB.TextBox txtResult
Height = 5775
Left = 4320
MultiLine = -1 'True
TabIndex = 4
Top = 1440
Width = 2655
End
Begin VB.CommandButton cmdClear
Caption = "Clear"
Height = 375
Left = 480
TabIndex = 3
Top = 7320
Width = 2655
End
Begin VB.CommandButton cmdAdd
Caption = "Add"
Height = 375
Left = 2280
TabIndex = 2
Top = 1080
Width = 855
End
Begin VB.TextBox txtAdd
Height = 375
Left = 480
TabIndex = 1
Top = 1080
Width = 1815
End
Begin VB.ListBox lstValues
Height = 5715
Left = 480
TabIndex = 0
Top = 1440
Width = 2655
End
End
Attribute VB_Name = "frmMatchValues"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'Developer govinn
'Logic Vasc
Dim Values() As Double
Private Sub cmdAdd_Click()
If IsNumeric(txtAdd.Text) Then
lstValues.AddItem txtAdd.Text
txtAdd.SelStart = 0
txtAdd.SelLength = Len(txtAdd.Text)
txtAdd.SetFocus
Else
MsgBox "Enter Number Values"
End If
End Sub
Private Sub cmdClear_Click()
lstValues.Clear
End Sub
Private Sub cmdFind_Click()
If IsNumeric(txtFind.Text) Then
txtResult.Text = ""
Call sort
txtResult.Text = findValues(UBound(Values), CDbl(txtFind.Text))
If txtResult.Text = "" Then txtResult.Text = "No Match"
Else
MsgBox "Enter Number Values"
End If
End Sub
Private Sub sort()
Dim ii As Integer
Dim rs As New Recordset
rs.Fields.Append "Value", adDouble
rs.Open
For ii = 0 To lstValues.ListCount - 1
rs.AddNew
rs(0) = lstValues.List(ii)
rs.Update
Next
rs.sort = "Value Desc"
lstValues.Clear
rs.MoveFirst
ii = 0
ReDim Values(rs.RecordCount - 1)
Do Until rs.EOF
Values(ii) = CDbl(rs("Value"))
ii = ii + 1
lstValues.AddItem CStr(rs("value"))
rs.MoveNext
Loop
End Sub
'Recursive Function with Vasc logic
Private Function findValues(ByVal ColPos As Integer, ByVal Value As Double) As String
Dim TempResult As String
Dim SumValue As Double
Dim NewValue As Double
Dim FoundVal As Boolean
Dim MaxPos As Integer, ii As Integer
MaxPos = UBound(Values)
For ii = ColPos To 0 Step -1
SumValue = SumValue + Values(MaxPos - ii)
Next
If Value > SumValue Then
findValues = ""
Exit Function
End If
'if no Value was found then iterate through table until the Value in table is less than MyValue
For ii = ColPos To 0 Step -1
If Values(MaxPos - ii) = Value Then
findValues = CStr(Value)
Exit Function
End If
If Values(MaxPos - ii) < Value Then
ColPos = ii
FoundVal = True
Exit For
End If
Next
If Not FoundVal Then
findValues = ""
Exit Function
End If
While (ColPos > 0)
NewValue = Values(MaxPos - ColPos)
ColPos = ColPos - 1
TempResult = findValues(ColPos, Value - NewValue)
If Trim(TempResult) <> "" Then
TempResult = CStr(NewValue) + vbNewLine + Trim(TempResult)
findValues = TempResult
Exit Function
End If
Wend
findValues = ""
End Function
Private Sub Form_Load()
lstValues.AddItem "10"
lstValues.AddItem "15"
lstValues.AddItem "21"
lstValues.AddItem "25"
lstValues.AddItem "26"
lstValues.AddItem "30"
lstValues.AddItem "30"
lstValues.AddItem "40"
lstValues.AddItem "41"
lstValues.AddItem "45"
lstValues.AddItem "50"
lstValues.AddItem "55"
lstValues.AddItem "60"
lstValues.AddItem "60"
lstValues.AddItem "65"
lstValues.AddItem "70"
lstValues.AddItem "75"
lstValues.AddItem "80"
lstValues.AddItem "85"
lstValues.AddItem "90"
lstValues.AddItem "95"
lstValues.AddItem "100"
lstValues.AddItem "105"
End Sub
Regards,
gova -
The VB code Recursive Code is Working as good as the NonRecursive code in VB (at least that's how it seems)
I was trying 339, 219 with the SQL code and it took a while ...
Kindest Regards,Vasc
-
Vasc there is no possible combination of numbers from this data set that be summed so that the digit in the units column (right most column) can end in either a 4 or 9.
Mike
-
A couple of recomendations :
1. Sort on TSQL (it is good at it)
2. Write the algorithm in c (pointer arithmetic is blindly fast when compared with VB)
Just my $0.02
* Noel -
: ) That's the catch to make to alg process as many posibilities as posible : ) (wich takes time : ) )
Kindest Regards,Vasc
-
I use T-SQL Function.
T-SQL function will fail after @@NESTLEVEL = 32. So Front end calls are better. I use this to Update another field in a table. So I have to use T-SQL.
http://www.sqlservercentral.com/forums/shwmessage.aspx?forumid=8&messageid=185843#bm185879
Regards,
gova -
You can Use TSQL successfully
but my advice is to use the Alg that is NOT RECURSIVE (wich is fast my last VB post) and for MyStack,SOL use a Table Variable you should be fine with that in TSQL
Kindest Regards,Vasc
-
Vasc your alg runs fast in the VB version searching for numbers ending in 4 or 9. I should have know that the inability to have a combination of numbers that ended 4 or 9 was by design.
A great piece of logic..Mike
-
Vasc - I trying to make your VB non-recursive logic without sucess. Can you please post the entire form code as that I can save as .frm and work. I tried to get the logic. I am getting confused on the line
ReDim Preserve Sol(0)
Thanks.
Regards,
gova -
The code is messy : ) so it needs clean up : )
VERSION 5.00
Begin VB.Form Form1
Caption = "Form1"
ClientHeight = 3195
ClientLeft = 60
ClientTop = 345
ClientWidth = 4680
LinkTopic = "Form1"
ScaleHeight = 3195
ScaleWidth = 4680
StartUpPosition = 3 'Windows Default
Begin VB.CommandButton Command1
Caption = "Command1"
Height = 540
Left = 2775
TabIndex = 1
Top = 765
Width = 1395
End
Begin VB.TextBox Text1
Height = 615
Left = 345
TabIndex = 0
Text = "263"
Top = 720
Width = 2205
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim ArrayValues() As Double
Dim MyStack() As Integer
Dim Sol() As Double
Private Sub Command1_Click()
Dim val As Double
Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim High As Double
Dim Low As Double
Dim Found As Boolean
Dim count As Integer
Dim AllSum As Double
AllSum = 0
count = 0
Found = False
cn.CursorLocation = adUseClient
cn.Provider = "SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;Initial Catalog=test1;Data Source=ITWSVK01"
cn.Open
val = CDbl(Text1.Text)
rs.Open "select value From MyTable WHERE Value<=" + Str(val) + " order by Value", cn
While Not rs.EOF
count = count + 1
ReDim Preserve ArrayValues(count)
ArrayValues(count) = rs!Value
AllSum = AllSum + ArrayValues(count)
rs.MoveNext
Wend
Set rs = Nothing
cn.Close
Set cn = Nothing
If count = 0 Then
MsgBox "The value is smaller than the lowest value in the table" _
, vbOKOnly, "Error"
Exit Sub
End If
Dim MyElem As Double
Dim MySol As String
Dim cntSOl As Integer
Dim cntStack As Integer
cntStack = 0
mm = UBound(ArrayValues)
For ii = 1 To mm
cntStack = cntStack + 1
ReDim Preserve MyStack(cntStack)
MyStack(cntStack) = ii
Next ii
ReDim Preserve Sol(0)
While UBound(MyStack) > 0
MyElem = MyStack(UBound(MyStack))
If MyElem = Sol(UBound(Sol)) Then
ReDim Preserve MyStack(UBound(MyStack) - 1)
ReDim Preserve Sol(UBound(Sol) - 1)
val = val + ArrayValues(MyElem)
AllSum = AllSum + ArrayValues(MyElem)
If UBound(Sol) = 1 Then AllSum = AllSum - ArrayValues(MyElem)
Else
cntSOl = UBound(Sol)
cntSOl = cntSOl + 1
ReDim Preserve Sol(cntSOl)
Sol(cntSOl) = MyElem
val = val - ArrayValues(MyElem)
AllSum = AllSum - ArrayValues(MyElem)
If val = 0 Then
For jj = 1 To UBound(Sol)
MySol = MySol + Str(ArrayValues(Sol(jj)))
Next jj
MsgBox MySol
Exit Sub
Else
If AllSum >= val Then
'check to see if the value is in the remaining values
For rr = MyElem - 1 To 1 Step -1
If val = ArrayValues(rr) Then
For jj1 = 1 To UBound(Sol)
MySol = MySol + Str(ArrayValues(Sol(jj1)))
Next jj1
MsgBox MySol + " " + Str(val)
Exit Sub
End If
Next rr
While ArrayValues(MyElem) > val
MyElem = MyElem - 1
Wend
If MyElem > 1 Then
For kk = 1 To MyElem - 1
ReDim Preserve MyStack(UBound(MyStack) + 1)
MyStack(UBound(MyStack)) = kk
Next kk
End If
End If
End If
End If
Wend
MsgBox "notfound"
End Sub
'Dim ArrayValues() As Double
'Dim MyStack() As Integer
'Dim Sol() As Double
'
'Private Sub Command1_Click()
'
'Dim val As Double
'Dim cn As New ADODB.Connection
'Dim rs As New ADODB.Recordset
'Dim High As Double
'Dim Low As Double
'Dim Found As Boolean
'Dim count As Integer
'
'count = 0
'Found = False
'
'cn.CursorLocation = adUseClient
'cn.Provider = "SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;Initial Catalog=test1;Data Source=ITWSVK01"
'cn.Open
'
'val = CDbl(Text1.Text)
'rs.Open "select value From MyTable WHERE Value<=" + Str(val) + " order by Value", cn
'While Not rs.EOF
' count = count + 1
' ReDim Preserve ArrayValues(count)
' ArrayValues(count) = rs!Value
' rs.MoveNext
'Wend
'
'Set rs = Nothing
'cn.Close
'Set cn = Nothing
'
'If count = 0 Then
' MsgBox "The value is smaller than the lowest value in the table" _
' , vbOKOnly, "Error"
' Exit Sub
'End If
'
''For i = LBound(ArrayValues) To UBound(ArrayValues)
'' MsgBox Str(i) + Str(ArrayValues(i))
''Next i
'Dim MyElem As Double
'Dim MySol As String
'Dim cntSOl As Integer
'Dim cntStack As Integer
'cntStack = 0
'
'
' mm = UBound(ArrayValues)
'For ii = 1 To mm
' cntStack = cntStack + 1
' ReDim Preserve MyStack(cntStack)
' MyStack(cntStack) = ii
'Next ii
'
'
'
'ReDim Preserve Sol(0)
'While UBound(MyStack) > 0
' MyElem = MyStack(UBound(MyStack))
' If MyElem = Sol(UBound(Sol)) Then
' ReDim Preserve MyStack(UBound(MyStack) - 1)
' ReDim Preserve Sol(UBound(Sol) - 1)
' Else
'
' cntSOl = UBound(Sol)
' cntSOl = cntSOl + 1
' ReDim Preserve Sol(cntSOl)
' Sol(cntSOl) = MyElem
'
' If CHeckSol(val) Then
' For jj = 1 To UBound(Sol)
' MySol = MySol + Str(ArrayValues(Sol(jj)))
' Next jj
' MsgBox MySol
' Exit Sub
' Else
' If MyElem > 1 Then
' For kk = 1 To MyElem - 1
' ReDim Preserve MyStack(UBound(MyStack) + 1)
' MyStack(UBound(MyStack)) = kk
' Next kk
' End If
' End If
' End If
'Wend
'MsgBox "notfound"
'End Sub
'
'Public Function CHeckSol(MySum As Double) As Boolean
'Dim CurrSum As Double
'CurrSum = 0
'
' For i = 1 To UBound(Sol)
' CurrSum = CurrSum + ArrayValues(Sol(i))
' Next i
' If CurrSum = MySum Then
' CHeckSol = True
' Else
' CHeckSol = False
' End If
'End Function
'
Kindest Regards,Vasc
Viewing 15 posts - 76 through 90 (of 101 total)
You must be logged in to reply to this topic. Login to reply