Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
Combinatorics Algorithm
#10
This is my shot at it. It's probably not optimized, but it seems to work. My strategy is to only try to fit the smaller of the two longs, and I start with the biggest integers first.

If you want to try it with your own numbers, call GroupAddends with the longs in SUM(), the integers in Choices() (starting with Choices(1)), and the number of integers in n. The output is in Groups(), with the number of integers for the jth long in Groups(j, 0), and the integers starting from Groups(j, 1).

Code:
DEFINT A-Z

DECLARE SUB Sort (Array%(), n%)
DECLARE SUB GroupAddends (Sum() AS LONG, Choices%(), n%, Groups%(), Errr%)
DECLARE SUB FindAddends (Chcs%(), n%, BYVAL Total AS LONG, Sum AS LONG, Addends%(), Errr%)

DIM Sum(1) AS LONG, Total AS LONG

n = 14
DIM Choices(n), Groups(1, n)

CLS
RANDOMIZE TIMER

'------------- Generate & Display Numbers -----------------
Adds0 = INT(RND * (n - 1) + 1)

FOR j = 1 TO n
  Choices(j) = INT(RND * 1000 + .5)
  PRINT Choices(j);
  IF j <= Adds0 THEN
    Sum(0) = Sum(0) + Choices(j)
    IF j < Adds0 THEN
      PRINT "+";
    ELSE
      PRINT "="; Sum(0)
    END IF
  ELSE
    Sum(1) = Sum(1) + Choices(j)
    IF j < n THEN
      PRINT "+";
    ELSE
      PRINT "="; Sum(1)
    END IF
  END IF
NEXT
PRINT
'------------ End of Genrate & Display Numbers ------------

GroupAddends Sum(), Choices(), n, Groups(), Errr

'-------------------  Display Results  --------------------
FOR i = 0 TO 1
  Total = 0
  FOR j = 1 TO Groups(i, 0) - 1
    Total = Total + Groups(i, j)
    PRINT Groups(i, j); "+";
  NEXT
  Total = Total + Groups(i, j)
  PRINT Groups(i, j); "="; Total
NEXT
PRINT "Error ="; Errr
'-------------------- End of Display results --------------

SUB FindAddends (Chcs(), n, BYVAL Total AS LONG, Sum AS LONG, Addends(), Errr)
  DIM Adds(n)
  Errr = 10000
  j = n
  DO
    IF Total <= Sum THEN
      IF Sum - Total < Errr THEN
        Errr = Sum - Total
        Addends(0) = j
        FOR i = 1 TO j
          Addends(i) = Chcs(i)
        NEXT
      END IF
      EXIT SUB
    ELSE
      Total = Total - Chcs(j)
      IF Chcs(j) < Sum THEN
        FindAddends Chcs(), j - 1, Total, Sum - Chcs(j), Adds(), NewEr
        IF Sum - Chcs(j) < NewEr THEN
          IF Sum - Chcs(j) < Errr THEN
            Addends(0) = 1
            Addends(1) = Chcs(j)
            Errr = Sum - Chcs(j)
          END IF
        ELSEIF NewEr < Errr THEN
          Errr = NewEr
          Addends(0) = Adds(0) + 1
          FOR i = 1 TO Adds(0)
            Addends(i) = Adds(i)
          NEXT
          Addends(Addends(0)) = Chcs(j)
          IF NewEr = 0 THEN EXIT SUB
        END IF
      ELSE
        IF Chcs(j) - Sum < Errr THEN
          Errr = Chcs(j) - Sum
          Addends(0) = 1
          Addends(1) = Chcs(j)
        END IF
        IF Chcs(j) = Sum THEN EXIT SUB
      END IF
    END IF
    j = j - 1
  LOOP WHILE j > 0
END SUB

SUB GroupAddends (Sum() AS LONG, Choices(), n, Groups(), Errr)
  DIM Addends(n), Total AS LONG
  Sort Choices(), n
  Smaller = -(Sum(1) < Sum(0))
  Total = Sum(0) + Sum(1)
  FindAddends Choices(), n, Total, Sum(Smaller), Addends(), Errr

  CIndex = 1
  GIndex = 0

  Groups(Smaller, 0) = Addends(0)
  Groups(1 - Smaller, 0) = n - Addends(0)

  FOR j = 1 TO Addends(0)
    WHILE Addends(j) > Choices(CIndex)
      GIndex = GIndex + 1
      Groups(1 - Smaller, GIndex) = Choices(CIndex)
      CIndex = CIndex + 1
    WEND
    Groups(Smaller, j) = Addends(j)
    CIndex = CIndex + 1
  NEXT

  IF CIndex <= n THEN
    FOR j = CIndex TO n
      GIndex = GIndex + 1
      Groups(1 - Smaller, GIndex) = Choices(j)
    NEXT
  END IF
END SUB

SUB Sort (Array(), n)
  DO
    Changes = 0
    FOR j = 0 TO n - 1
      IF Array(j) > Array(j + 1) THEN
        SWAP Array(j), Array(j + 1)
        Changes = Changes + 1
      END IF
    NEXT
  LOOP WHILE Changes > 0
END SUB
hrist Jesus came into the world to save sinners, of whom I am first.(I Timothy 1:15)

For God so loved the world, that He gave His only begotten Son,
that whoever believes in Him should not perish, but have eternal life.(John 3:16)
Reply


Messages In This Thread
Combinatorics Algorithm - by Agamemnus - 12-21-2003, 09:00 PM
challenge specifics: - by Meg - 12-22-2003, 03:28 AM
Combinatorics Algorithm - by Agamemnus - 12-22-2003, 06:21 AM
Combinatorics Algorithm - by Agamemnus - 12-29-2003, 04:25 AM
Combinatorics Algorithm - by Rhiannon - 12-29-2003, 04:48 AM
Combinatorics Algorithm - by Neo - 12-29-2003, 05:42 PM
Combinatorics Algorithm - by Agamemnus - 12-31-2003, 01:07 AM
Combinatorics Algorithm - by Neo - 12-31-2003, 06:42 PM
Combinatorics Algorithm - by Agamemnus - 12-31-2003, 11:09 PM
Combinatorics Algorithm - by SCM - 01-02-2004, 06:54 AM
Combinatorics Algorithm - by Agamemnus - 01-02-2004, 07:29 PM
Combinatorics Algorithm - by qbiscool - 03-09-2004, 08:39 AM
Combinatorics Algorithm - by na_th_an - 03-09-2004, 02:39 PM
Combinatorics Algorithm - by SCM - 03-26-2004, 08:05 AM
Combinatorics Algorithm - by Agamemnus - 03-28-2004, 12:23 AM

Forum Jump:


Users browsing this thread: 1 Guest(s)