PureBasic Forums - English

Code: Select all

EnableExplicit

Procedure.i Monotone (Array a.i(1), lo.i=0, hi.i=-1)
   ; -- Check whether all values in (a selected range of) an
   ;    integer array are (strictly) decreasing or increasing
   ; in : a(): array to be checked
   ;      lo : least   index to be considered
   ;      hi : largest index to be considered
   ; out: The values in the examined range are
   ;      -2: strictly decreasing
   ;      -1: monotonically decreasing
   ;       0: neither monotonically decreasing nor increasing
   ;       1: monotonically increasing
   ;       2: strictly increasing
   Protected.i i, k, ret, sgn, factor=2
   
   If hi = -1
      hi = ArraySize(a())
   EndIf   
   
   ; -- Look for the first difference <> 0
   i = lo + 1
   Repeat
      If i > hi
         ProcedureReturn 0       ; neither decreasing nor increasing
      EndIf   
      ret = Sign(a(i) - a(i-1))
      i + 1
   Until ret <> 0
   If i > lo + 2
      factor = 1                 ; not *strictly* monotone
   EndIf
   
   ; -- Check whether all other differences <> 0 have
   ;    the same sign as the first difference <> 0
   For k = i To hi
      sgn = Sign(a(k) - a(k-1))
      If sgn = 0
         factor = 1              ; not *strictly* monotone
      ElseIf sgn <> ret
         ProcedureReturn 0       ; not monotone
      EndIf   
   Next
   
   ProcedureReturn ret * factor
EndProcedure


; -- Demo
Procedure CreateArray (Array a.i(1), values$)
   Protected.i i, last
   
   last = CountString(values$, ",")
   Dim a(last)
   
   For i = 0 To last
      a(i) = Val(StringField(values$, i+1, ","))
   Next   
EndProcedure

Dim a.i(0)

CreateArray(a(), "4, 3, 2, 1, 0")
Debug Monotone(a())

CreateArray(a(), "4, 4, 3, 2, 0")
Debug Monotone(a())

CreateArray(a(), "3, 3, 3, 3, 3")
Debug Monotone(a())

CreateArray(a(), "4, 3, 0, 6, 7")
Debug Monotone(a())

CreateArray(a(), "0, 2, 3, 3, 4")
Debug Monotone(a())

CreateArray(a(), "0, 1, 2, 3, 4")
Debug Monotone(a())