Task: Maximum triangle path sum








VB: 

Set objfso = CreateObject("Scripting.FileSystemObject")
Set objinfile = objfso.OpenTextFile(objfso.GetParentFolderName(WScript.ScriptFullName) &_
	"\triangle.txt",1,False)
	
row = Split(objinfile.ReadAll,vbCrLf)

For i = UBound(row) To 0 Step -1
	row(i) = Split(row(i)," ")
	If i < UBound(row) Then
		For j = 0 To UBound(row(i))
			If (row(i)(j) + row(i+1)(j)) > (row(i)(j) + row(i+1)(j+1)) Then
				row(i)(j) = CInt(row(i)(j)) + CInt(row(i+1)(j))
			Else
				row(i)(j) = CInt(row(i)(j)) + CInt(row(i+1)(j+1))
			End If
		Next
	End If	
Next

WScript.Echo row(0)(0)

objinfile.Close
Set objfso = Nothing



Fortran:       MODULE PYRAMIDS	
       INTEGER MANY		
       PARAMETER (MANY = 666)	
       INTEGER BRICK(MANY),IN,LAYERS	
       CONTAINS
        SUBROUTINE IMHOTEP(PLAN)
Counting is from the apex down, the Erich von Daniken construction.
         CHARACTER*(*) PLAN	
         INTEGER I,IT		
         CHARACTER*666 ALINE	
          IN = 0		
          LAYERS = 0		
          WRITE (6,*) "Reading from ",PLAN	
          OPEN(10,FILE=PLAN,FORM="FORMATTED",ACTION="READ",ERR=6)	
          GO TO 10		
    6     STOP "Can't grab the file
Chew into the plan.
   10     READ (10,11,END = 20) ALINE	
   11     FORMAT (A)			
          IF (ALINE .EQ. "") GO TO 10	
          IF (ALINE(1:1).EQ."%") GO TO 10	
          LAYERS = LAYERS + 1		
          IF (IN + LAYERS.GT.MANY) STOP "Too many bricks
          READ (ALINE,*,END = 15,ERR = 15) BRICK(IN + 1:IN + LAYERS)	
          IN = IN + LAYERS		
          GO TO 10			
Caught a crab? A bad number, or too few numbers on a line? No read-next-record antics, thanks.
   15     WRITE (6,16) LAYERS,ALINE	
   16     FORMAT ("Bad layer ",I0,": ",A)
Completed the plan.
   20     WRITE (6,21) IN,LAYERS	
   21     FORMAT (I0," bricks in ",I0," layers.")
          CLOSE(10)			
Cast forth the numbers in a nice pyramid.
   30     IT = 0		
          DO I = 1,LAYERS	
            WRITE (6,31) BRICK(IT + 1:IT + I)	
   31       FORMAT (<LAYERS*2 - 2*I>X,666I4)	
            IT = IT + I				
          END DO		
        END SUBROUTINE IMHOTEP	

        SUBROUTINE TRAVERSE	
C   The idea is that a pyramid of numbers is provided, and then, starting at the peak,
c work down to the base summing the numbers at each step to find the maximum value path.
c The constraint is that from a particular brick, only the two numbers below left and below right
c may be reached in stepping to that lower layer.
c   Since that is a 0/1 choice, recorded in MOVE, a base-two scan searches the possibilities.
         INTEGER MOVE(LAYERS)		
         INTEGER STEP(LAYERS),WALK(LAYERS)	
         INTEGER I,L,IT		
         INTEGER PS,WS		
          WRITE (6,1) LAYERS		
    1     FORMAT (//,"Find the highest score path across a pyramid of ",
     1     I0," layers."/)	
          MOVE = 0	
          MOVE(1) = 1	
          STEP(1) = 1	
          WS = -666	
Commence a multi-level loop, using the values of MOVE as the digits, one digit per level.
   10       IT = 1		
            PS = BRICK(1)	
c            write (6,8) "Move",MOVE,WS
            DO L = 2,LAYERS	
              IT = IT + L - 1 + MOVE(L)	
              STEP(L) = IT		
              PS = PS + BRICK(IT)	
c              WRITE (6,6) L,IT,BRICK(IT),PS
    6         FORMAT ("Layer ",I0,",Brick(",I0,")=",I0,",Sum=",I0)
            END DO		
            IF (PS .GT. WS) THEN	
              IF (WS.GT.0) WRITE (6,7) WS,PS	
    7         FORMAT ("Improved path score: ",I0," to ",I0)
              WRITE (6,8) "Moves",MOVE		
              WRITE (6,8) "Steps",STEP		
              WRITE (6,8) "Score",BRICK(STEP)	
    8         FORMAT (A8,666I4)			
              WS = PS				
              WALK = STEP			
            END IF			
            DO L = LAYERS,1,-1		
              IF (MOVE(L).EQ.0) THEN	
                MOVE(L) = 1		
                MOVE(L + 1:LAYERS) = 0	
                GO TO 10		
              END IF		
            END DO		
          WRITE (6,*) WS," is the highest score."	
        END SUBROUTINE TRAVERSE	

        SUBROUTINE REFINE	
         INTEGER BEST(LAYERS)	
         INTEGER I,L		
          L = LAYERS*(LAYERS - 1)/2 + 1	
          BEST = BRICK(L:L + LAYERS - 1)
          DO L = LAYERS - 1,1,-1	
            FORALL (I = 1:L) BEST(I) = BRICK(L*(L - 1)/2 + I)	
     1                               + MAXVAL(BEST(I:I + 1))	
          END DO			
          WRITE (6,*) BEST(1)," is the highest score. By some path."
        END SUBROUTINE REFINE	
      END MODULE PYRAMIDS

      PROGRAM TRICKLE
      USE PYRAMIDS
c      CALL IMHOTEP("Sakkara.txt")
      CALL IMHOTEP("Cheops.txt")
      CALL TRAVERSE			
      CALL REFINE			
      END