Haskell-like recursive map

[AutoXenon]

local $a=pack(948)
local $b=map(sumSelfAndSquare,$a)

msgbox(0,'',unpack($a))
msgbox(0,'',unpack($b))

func map($f,$xs)
     return IsArray($xs[0]) ? __mapContinue($f,$xs) : __mapLast($f,$xs)
endfunc

func __mapContinue($f,$xs)
     local $arr = [ map($f,$xs[0]) , $f($xs[1]) ]
     return $arr
endfunc

func __mapLast($f,$xs)
     local $arr = [$f($xs[0])]
     return $arr
endfunc

func unpack($arr)
     return IsArray($arr[0]) ? $arr[1] & ' , ' & unpack($arr[0]) : $arr[0]
endfunc

func pack($n)
     if $n<1 then 
        local $a = [ $n ]
     else
        local $a = [ pack($n-1) , $n ]
     endif
     return $a
endfunc

func sumSelfAndSquare($x)
     return $x*$x + $x
endfunc

 

[mistersquirrle]

I think this is pretty cool, took me a while to get my head around it, and I assume that you meant to post it in the example scripts section, unless you have a question?

I also changed the names of some params to better understand it personally, and while it's neat, I don't see a use for it myself. Here's my updates, and comparison to a 'normal' way of doing it in AutoIt:

expandcollapse popup

Global $hTimer = TimerInit()

#Region Haskell-like
Global $a = pack(948)
ConsoleWrite('pack(948): ' & Round(TimerDiff($hTimer), 2) & ' ms' & @CRLF)
$hTimer = TimerInit()
Global $b = map(sumSelfAndSquare, $a)
ConsoleWrite('map(sumSelfAndSquare, $a): ' & Round(TimerDiff($hTimer), 2) & ' ms' & @CRLF)

$hTimer = TimerInit()
ConsoleWrite('unpack($a): ' & unpack($a) & ': ' & Round(TimerDiff($hTimer), 2) & ' ms' & @CRLF & @CRLF)
$hTimer = TimerInit()
ConsoleWrite('unpack($b): ' & unpack($b) & ': ' & Round(TimerDiff($hTimer), 2) & ' ms' & @CRLF & @CRLF)
#EndRegion Haskell-like

#Region Normal array and loop
$hTimer = TimerInit()
Global $aPack[948]
ConsoleWrite('$aPack[948]: ' & Round(TimerDiff($hTimer), 2) & ' ms' & @CRLF)
$hTimer = TimerInit()
For $iIndex = 0 To UBound($aPack) - 1
    $aPack[$iIndex] = sumSelfAndSquare($iIndex)
Next
ConsoleWrite('$aPack = sumSelfAndSquare: ' & Round(TimerDiff($hTimer), 2) & ' ms' & @CRLF)

$hTimer = TimerInit()
For $iIndex = 0 To UBound($aPack) - 1
    ConsoleWrite($aPack[$iIndex] & (($iIndex = UBound($aPack) - 1) ? '' : ' , '))
Next
ConsoleWrite(@CRLF)
ConsoleWrite('$aPack logging: ' & Round(TimerDiff($hTimer), 2) & ' ms' & @CRLF)
#EndRegion Normal array and loop

Func map($sFunc, $aPackedData)
    Return IsArray($aPackedData[0]) ? __mapContinue($sFunc, $aPackedData) : __mapLast($sFunc, $aPackedData)
EndFunc   ;==>map

Func __mapContinue($sFunc, $aPackedData)
    Local $aArray = [map($sFunc, $aPackedData[0]), $sFunc($aPackedData[1])]
    Return $aArray
EndFunc   ;==>__mapContinue

Func __mapLast($sFunc, $aPackedData)
    Local $aArray = [$sFunc($aPackedData[0])]
    Return $aArray
EndFunc   ;==>__mapLast

Func unpack($aArray)
    Return IsArray($aArray[0]) ? $aArray[1] & ' , ' & unpack($aArray[0]) : $aArray[0]
EndFunc   ;==>unpack

Func pack($iIndex)
    If $iIndex > 0 Then
        Local $a = [pack($iIndex - 1), $iIndex]
    ElseIf $iIndex = 0 Then
        Local $a = [$iIndex]
    Else
        Local $a = [1]
        Return SetError(1, $iIndex, $a)
    EndIf
    Return $a
EndFunc   ;==>pack

Func sumSelfAndSquare($x)
    Return $x * $x + $x
EndFunc   ;==>sumSelfAndSquare

For me it took around ~30ms for the Haskell like code (excluding unpacking $a), and ~6.7ms for the normal array approach. I can't personally see any use for implementing this, considering that it took me a while to understand what's happening, it just wouldn't be worth it to me to add this complexity for no benefit that I can see. Please let me know if I'm missing some awesome use-case for this.

 

Otherwise again I do think this is neat. And kudos to you for implementing it with AutoIt.

[mistersquirrle]

I'm finding whatever I can to procrastinate finishing and releasing my own project, so here's a method very very close to what you've provided, but doing it in a much more (in my opinion) straight-forward way:

expandcollapse popup

Global $hTimer = TimerInit()

Global $a = Pack(948)
ConsoleWrite('- Pack(948): ' & Round(TimerDiff($hTimer), 2) & ' ms' & @CRLF & @CRLF)

$hTimer = TimerInit()
Global $b = Map("sumSelfAndSquare", $a)
ConsoleWrite('- Map("sumSelfAndSquare", $a): ' & Round(TimerDiff($hTimer), 2) & ' ms' & @CRLF & @CRLF)

$hTimer = TimerInit()
Global $b = Map(sumSelfAndSquare, $a)
ConsoleWrite('- Map(sumSelfAndSquare, $a): ' & Round(TimerDiff($hTimer), 2) & ' ms' & @CRLF & @CRLF)

$hTimer = TimerInit()
ConsoleWrite(Unpack($a) & @CRLF & @CRLF)
ConsoleWrite('- Unpack($a): ' & Round(TimerDiff($hTimer), 2) & ' ms' & @CRLF & @CRLF)

$hTimer = TimerInit()
ConsoleWrite(Unpack($b) & @CRLF & @CRLF)
ConsoleWrite('- Unpack($b): ' & Round(TimerDiff($hTimer), 2) & ' ms' & @CRLF & @CRLF)

Func Map($sFunction, $aArray)
    Local $sResult[UBound($aArray)]
    For $i = 0 To UBound($aArray) - 1
        If IsFunc($sFunction) Then
            $sResult[$i] = $sFunction($aArray[$i])
        Else
            $sResult[$i] = Call($sFunction, $aArray[$i])
        EndIf
    Next
    Return $sResult
EndFunc   ;==>Map

Func Unpack($aArray)
    Local $sResult = ""
    For $i = 0 To UBound($aArray) - 1
        $sResult &= $aArray[$i]
        If $i < UBound($aArray) - 1 Then $sResult &= " , "
    Next
    Return $sResult
EndFunc   ;==>Unpack

Func Pack($iIndex)
    Local $aArray[$iIndex]
    For $i = 0 To $iIndex - 1
        $aArray[$i] = $i
    Next
    Return $aArray
EndFunc   ;==>Pack

Func sumSelfAndSquare($x)
    Return $x * $x + $x
EndFunc   ;==>sumSelfAndSquare

No recursion with a nest of arrays, otherwise I think that it adopts to what you were showcasing. This just breaks my brain less.

[AspirinJunkie]

I'm trying to figure out why the data is structured just this way.
You create an incredibly nested structure (948 nested levels!).
But I don't know why it wouldn't be enough to create a simple array with the values and apply the mapping function to each of these elements.
The result would be the same, but much easier to understand and better performing.
Can you give me a hint if I am missing something important?

I have also dealt with this topic before.
The result are some functions, which then are included in my ArrayPlus-UDF.
In order to produce the same result as yours, a single line of code would suffice with the UDF:

#include "ArrayPlus.au3"

; create Array with initial values 948..0 and map a user defined function to these values:
$a = _ArrayCreate("948:0:-1", "$A*$A + $A")

; display the result:
_ArrayDisplay($a, "result")

Or if it should be more like your setup with an explicit map function then like this:

#include "ArrayPlus.au3"

; create array with values 948..0
$a = _ArrayCreate("0:948")

; map a function to every element of the array
_ArrayMap($a, sumSelfAndSquare)

; display the result
_ArrayDisplay($a, "result")


func sumSelfAndSquare($x)
    return $x*$x + $x
endfunc

 

Edited March 29, 2023 by AspirinJunkie

[AutoXenon]

Actually, map isn't a very interesting use case for this since, as you've said, it is inherently a "flat" operation more naturally described by arrays rather than lists

What a really interesting use case for this is being able to elegantly write foldl and foldr in AutoIt, i.e.

foldl( f , init , list ) = f( f( f( ... f( f( f( init , list[0]) , list[1] ) , list[2] ) , ... ) , list[n-1] ) , list[n] )

foldr( f , list , init ) = f( list[0] , f( list[1] , f( ... , f( list[n-2] , f( list[n-1] , f( list[n] , init ) ) ) ... ) ) )

Note the main difference between the two folds is that one have the head being the innermost element while the other have it as the outermost.

Working example (sum of odd numbers makes perfect squares, useful when drawing circles in Minecraft)

expandcollapse popup

local $a = enumerate(1569) ; 1570 crashes the interpreter without triggering recursion limit warning, memory bug maybe?
local $b = packLeft($a)
local $c = packRight($a)
msgbox(0,'packLeft',unpack($b))
msgbox(0,'packRight',unpack($c))
msgbox(0,'foldl',foldl(addOddLeft,0,$b))
msgbox(0,'foldr',foldr(addOddRight,$c,0))

for $i=1 to 10
    local $a = enumerate($i)
    local $b=foldl_FromFlatArray(addOddLeft,0,$a)
    local $c=foldr_FromFlatArray(addOddRight,$a,0)
    msgbox(0,$i & ' squared','foldl result: ' & $b & @CRLF & 'foldr result: ' & $c)
next

func addOddLeft($left, $right)
     return $left + ($right*2 - 1)
endfunc

func addOddRight($left, $right)
     return ($left*2 - 1) + $right
endfunc

func foldl($f, $x0, $xs)
     return IsArray($xs[0]) ? $f( foldl($f,$x0,$xs[0]) , $xs[1] ) : $f($x0,$xs[0])
endfunc

func foldr($f, $xs, $x0)
     return IsArray($xs[0]) ? $f( $xs[1] , foldr($f,$xs[0],$x0) ) : $f($xs[0],$x0)
endfunc

func foldl_FromFlatArray($f, $ini, $arr)
     return foldl($f,$ini,packLeft($arr))
endfunc

func foldr_FromFlatArray($f, $arr, $ini)
     return foldr($f,packRight($arr),$ini)
endfunc

func packLeft($arr)
     return __packL($arr,UBound($arr)-1)
endfunc

func packRight($arr)
     return __packR($arr,0)
endfunc

func unpack($arr)
     return IsArray($arr[0]) ? $arr[1] & ' , ' & unpack($arr[0]) : $arr[0]
endfunc

; === Boring Internal Implementation ===

func __packL($arr, $index)
     if $index>0 Then
        local $a = [ __packL($arr,$index-1) , $arr[$index]]
     else
        local $a = [ $arr[0] ]
     endif
     return $a
endfunc

func __packR($arr, $index)
     if $index<UBound($arr)-1 Then
        local $a = [ __packR($arr,$index+1) , $arr[$index] ]
     else
        local $a = [ $arr[UBound($arr)-1] ]
     endif
     return $a
endfunc

func enumerate($n)
     local $arr[$n]
     for $i=0 to $n-1
         $arr[$i] = $i+1
     next
     return $arr
endfunc

 

This is just a fun exercise in pushing what's possible with AutoIt, obviously this is totally impractical for AutoIt since it's not optimized for recursion.

It seems that AutoIt's built-in recursion limit is 1898, in the original post it's halved since there's an extra __map call at each layer.

This Fold example doesn't trigger the interpreter's recursion limit, however, instead it just crashes immediately once it reaches 1570 (1569 is fine and calculates instantly on my laptop, with AutoIt version 3.3.16.0 -- haven't tested the newer release since it keeps triggering the antivirus)

Edited March 30, 2023 by AutoXenon

[AspirinJunkie]

I have to admit that I have a hard time understanding the intent of the code. Probably mainly because it comes completely uncommented or without any other explanation. 

However, as I see it, the example simply calculates a certain cumulative sum over a series of numbers.
I don't see the necessity of a recursion anywhere.

As an example, you can calculate the whole thing over a normal flat 1D array - then you don't care about the recursion depth:

#include "ArrayPlus.au3"

; create Array with values from 1 to 1569
Global $aArray = _ArrayCreate("1:1569")

; calculate user defined cumulated sum over whole array:
$iOddSum = _ArrayReduce($aArray, addOdd)

; print the result
MsgBox(0, "addOdd", $iOddSum)


; the user defined cumulation function
Func addOdd(ByRef $sum, $val)
    $sum += $val*2 - 1
EndFunc

Or to clarify once again that this is really only a cumulative sum:

#include "ArrayPlus.au3"

; create a array and set the values to
Global $aArray = _ArrayCreate("1:1569", "$A + $A - 1")

For $i = 0 To 9
    $nResult = _ArraySum($aArray, 0, $i)

    msgbox(0,$i + 1 & ' squared','result: ' & $nResult)
Next



; calculate the sum over a array
Func _ArraySum(ByRef $aArr, $iStart = 0, $iEnd = UBound($aArr) - 1)
    Local Const $nEls = UBound($aArr)
    If $nEls < 1 Then Return SetError(1, $nEls, Null)
    If UBound($aArr, 0) <> 1 Then Return SetError(2, UBound($aArr, 0), Null)
    If $iStart < 0 Or ($iStart >= $nEls) Then Return SetError(3, $iStart, Null)
    If $iEnd   < 0 Or ($iEnd   >= $nEls) Then Return SetError(4, $iEnd, Null)
    If $iEnd < $iStart Then Return SetError(5, $iEnd, Null)

    Local $nSum = 0

    For $i = $iStart To $iEnd
        $nSum += $aArr[$i]
    Next
    Return $nSum
EndFunc