Given a 12-member set of consecutive integers
(1,2,3…11,12).
Partition it into 3 subsets, each with a distinct number of members ,
e.g .
A=(1,2); B=(3,5,11,12) & C=(4,6,7,8,9,10).
Evaluate the sums of the members for each of the subsets, in our example:
Sa=3 ; Sb=31 & Sc=44;
Now evaluate:
F1 (product of the three sums) =
Sa * Sb * Sc, i.e. 3*31*44 = 4092 in our example.
F2= S
a * S
b + S
c; equals to
93+44=137 in our case.
F3= d(S
a) +d(S
b) + d(S
c); where d(N) is the number of N's divisors.
So in our case
F3=2+2+6 = 10.
The 3
independent tasks :
Executing the above procedures find the partitions of the main set, that provide maximum values for F1, F2 & F3.
DefDbl A-Z
Dim crlf$, settot(3), setcard(3), setcntn(3, 12), f1max, f2max, f3max
Dim f1set(3, 12), f1card(3)
Dim f2set(3, 12), f2card(3)
Dim f3set(3, 12), f3card(3)
Dim fct(20, 1)
Private Sub Form_Load()
ChDir "C:\Program Files (x86)\DevStudio\VB\projects\flooble"
Text1.Text = ""
crlf$ = Chr(13) + Chr(10)
Form1.Visible = True
DoEvents
place 1
Text1.Text = Text1.Text & f1max & crlf
For s = 1 To 3
For i = 1 To f1card(s)
Text1.Text = Text1.Text & Str(f1set(s, i))
Next
Text1.Text = Text1.Text & " "
Next s
Text1.Text = Text1.Text & crlf
Text1.Text = Text1.Text & crlf
Text1.Text = Text1.Text & f2max & crlf
For s = 1 To 3
For i = 1 To f2card(s)
Text1.Text = Text1.Text & Str(f2set(s, i))
Next
Text1.Text = Text1.Text & " "
Next s
Text1.Text = Text1.Text & crlf
Text1.Text = Text1.Text & crlf
Text1.Text = Text1.Text & f3max & crlf
For s = 1 To 3
For i = 1 To f3card(s)
Text1.Text = Text1.Text & Str(f3set(s, i))
Next
Text1.Text = Text1.Text & " "
Next s
Text1.Text = Text1.Text & crlf
Text1.Text = Text1.Text & crlf
Text1.Text = Text1.Text & crlf & ct & " done"
End Sub
Sub place(wh)
For s = 1 To 3
settot(s) = settot(s) + wh
setcard(s) = setcard(s) + 1
setcntn(s, setcard(s)) = wh
If wh = 12 Then
If setcard(1) <> setcard(2) And setcard(2) <> setcard(3) And setcard(2) <> setcard(1) Then
f1 = settot(1) * settot(2) * settot(3)
If f1 > f1max Then
f1max = f1
For st = 1 To 3
f1card(st) = setcard(st)
For i = 1 To setcard(st)
f1set(st, i) = setcntn(st, i)
Next
Next
End If
f2 = settot(1) * settot(2) + settot(3)
If f2 > f2max Then ' And setcard(3) <> 0 Then
f2max = f2
For st = 1 To 3
f2card(st) = setcard(st)
For i = 1 To setcard(st)
f2set(st, i) = setcntn(st, i)
Next
Next
End If
f3 = dvsrs(settot(1)) + dvsrs(settot(2)) + dvsrs(settot(3))
If f3 > f3max Then
f3max = f3
For st = 1 To 3
f3card(st) = setcard(st)
For i = 1 To setcard(st)
f3set(st, i) = setcntn(st, i)
Next
Next
End If
End If
Else
place wh + 1
End If
settot(s) = settot(s) - wh
setcard(s) = setcard(s) - 1
Next
End Sub
Function dvsrs(n)
f = factor(n)
nf = 1
For i = 1 To f
nf = nf * (fct(i, 1) + 1)
Next
dvsrs = nf
End Function
Function factor(num)
diffCt = 0: good = 1
n = Abs(num): If n > 0 Then limit = Sqr(n) Else limit = 0
If limit <> Int(limit) Then limit = Int(limit + 1)
dv = 2: GoSub DivideIt
dv = 3: GoSub DivideIt
dv = 5: GoSub DivideIt
dv = 7
Do Until dv > limit
GoSub DivideIt: dv = dv + 4 '11
GoSub DivideIt: dv = dv + 2 '13
GoSub DivideIt: dv = dv + 4 '17
GoSub DivideIt: dv = dv + 2 '19
GoSub DivideIt: dv = dv + 4 '23
GoSub DivideIt: dv = dv + 6 '29
GoSub DivideIt: dv = dv + 2 '31
GoSub DivideIt: dv = dv + 6 '37
If INKEY$ = Chr$(27) Then s$ = Chr$(27): Exit Function
Loop
If n > 1 Then diffCt = diffCt + 1: fct(diffCt, 0) = n: fct(diffCt, 1) = 1
factor = diffCt
Exit Function
DivideIt:
cnt = 0
Do
q = Int(n / dv)
If q * dv = n And n > 0 Then
n = q: cnt = cnt + 1: If n > 0 Then limit = Sqr(n) Else limit = 0
If limit <> Int(limit) Then limit = Int(limit + 1)
Else
Exit Do
End If
Loop
If cnt > 0 Then
diffCt = diffCt + 1
fct(diffCt, 0) = dv
fct(diffCt, 1) = cnt
End If
Return
End Function
The program allows null sets:
F1, max value and the three sets a, b and c:
17576
1 2 3 8 12 4 5 6 11 7 9 10
F2, max value and the three sets a, b and c (c is null):
1521
1 2 3 4 5 6 7 11 8 9 10 12
F3, max value and the three sets a, b and c:
24
1 2 3 6 12 4 5 7 8 9 10 11
Disallowing null sets affects the maximum of only F2:
17576
1 2 3 8 12 4 5 6 11 7 9 10
1483
2 3 4 5 6 7 11 8 9 10 12 1
24
1 2 3 6 12 4 5 7 8 9 10 11
|
Posted by Charlie
on 2014-08-21 16:53:45 |