Jump to content

Variadic fixed-point combinator

From Rosetta Code
Task
Variadic fixed-point combinator
You are encouraged to solve this task according to the task description, using any language you may know.

A fixed-point combinator is a higher order function that returns the fixed point of its argument function. If the function has one or more fixed points, then .

You can extend a fixed-point combinator to find the fixed point of the i-th function out of n given functions:

Task

Your task is to implement a variadic fixed-point combinator that finds and returns the fixed points of all given functions:

The variadic input and output may be implemented using any feature of the language (e.g. using lists).

If possible, try not to use explicit recursion and implement the variadic fixed-point combinator using a fixed-point combinator like the Y combinator.

Also try to come up with examples where could actually be somewhat useful.

Related tasks
See also



Binary Lambda Calculus

As shown in https://github.com/tromp/AIT/blob/master/rosetta/variadicY.lam, a variadic Y combinator can take the list-based form

Ygen = \fs. map (\fi.fi (Ygen fs)) fs

which translates to a 276 bit BLC program to determine the parity of the input length:

000100010110010101010001101000000101000100011010000001011000000000010110011111111011110010111111101111110111010000110010111101110110100101100000010110000000010101111110000010000011011000001100101100000010110000000010111111000001101101000001000001101100000100000000101101110110
$ echo -n "hello" | ./blc run rosetta/variadicY.lam 
1

Bruijn

Derived from the linked Goldberg paper, as explained in Variadic Fixed-Point Combinators.

:import std/Combinator .
:import std/Number .
:import std/List .

# ---------------
# explicit Church
# ---------------

# passes all functions explicitly
explicit-y* [[[0 1] <$> 0] ([[1 <! ([[1 2 0]] <$> 0)]] <$> 0)]

# even x = if x == 0 then true else odd? (x-1)
g [[[=?0 [[1]] (1 --0)]]]

# odd x = if x == 0 then false else even? (x-1)
h [[[=?0 [[0]] (2 --0)]]]

# merged even/odd
rec explicit-y* (g : {}h)

:test (^rec (+5)) ([[0]])
:test (_rec (+5)) ([[1]])

# n % 3
mod3 ^(explicit-y* (zero : (one : {}two)))
	zero [[[[=?0 (+0) (2 --0)]]]]
	one [[[[=?0 (+1) (1 --0)]]]]
	two [[[[=?0 (+2) (3 --0)]]]]

:test ((mod3 (+5)) =? (+2)) ([[1]])

# ----------------
# explicit tupling
# ----------------

# passes all functions explicitly
# requires a tuple mapping function first
# or, minified: [[0 0] [[2 (1 1 0) 0]]] (38 bit!)
tupled-y* [y [[2 (1 0) 0]]]

# merged even odd
rec tupled-y* map [0 g h]
	map [&[[[0 (3 2) (3 1)]]]]

# [[1]] / [[0]] are tuple selectors:

:test (rec [[1]] (+5)) ([[0]])
:test (rec [[0]] (+5)) ([[1]])

# n % 3, [[[2]]] selects first tuple element
mod3 tupled-y* map [0 zero one two] [[[2]]]
	map [&[[[[0 (4 3) (4 2) (4 1)]]]]]
	zero [[[[=?0 (+0) (2 --0)]]]]
	one [[[[=?0 (+1) (1 --0)]]]]
	two [[[[=?0 (+2) (3 --0)]]]]

:test ((mod3 (+5)) =? (+2)) ([[1]])

# NOTE: You can merge the mapping argument directly into the list
#       like [[0 (1 A) (1 B) (1 C) ...]]. Then y*=y.

# ---------------
# implicit Church
# ---------------

# passes all functions in a single list
implicit-y* y [[&(1 0) <$> 0]]

# even x = if x == 0 then true else odd? (x-1)
g [[=?0 [[1]] (_1 --0)]]

# odd x = if x == 0 then false else even? (x-1)
h [[=?0 [[0]] (^1 --0)]]

# merged even/odd
rec implicit-y* (g : {}h)

:test (^rec (+5)) ([[0]])
:test (_rec (+5)) ([[1]])

# n % 3
mod3 ^(implicit-y* (zero : (one : {}two)))
	zero [[=?0 (+0) (_1 --0)]]
	one [[=?0 (+1) (^(~1) --0)]]
	two [[=?0 (+2) (^1 --0)]]

:test ((mod3 (+5)) =? (+2)) ([[1]])

F#

The following uses Y_combinator#March_2024

// Variadic fixed-point combinator. Nigel Galloway: March 15th., 2024
let h2 n = function 0->2 |g->   n (g-1) 
let h1 n = function 0->1 |g->h2 n (g-1) 
let h0 n = function 0->0 |g->h1 n (g-1)
let mod3 n=Y h0 n
[0..10] |> List.iter(mod3>>printf "%d "); printfn ""
Output:
0 1 2 0 1 2 0 1 2 0 1

FreeBASIC

Unfortunately, due to the limitations of the FreeBASIC language, implementing a variadic fixed-point combinator without explicit recursion is extremely difficult, if not impossible. FreeBASIC does not support higher-order functions in a way that allows this type of metaprogramming.

An alternative would be to implement recursion explicitly, although this does not satisfy your original requirement of avoiding explicit recursion.

Declare Function Even(n As Integer) As Integer
Declare Function Odd(n As Integer) As Integer

Function Even(n As Integer) As Integer
    If n = 0 Then Return 1
    Return Odd(n - 1)
End Function

Function Odd(n As Integer) As Integer
    If n = 0 Then Return 0
    Return Even(n - 1)
End Function

Function Collatz(n As Integer) As Integer
    Dim As Integer d = 0
    While n <> 1
        n = Iif(n Mod 2 = 0, n \ 2, 3 * n + 1)
        d += 1
    Wend
    Return d
End Function

Dim As String e, o
Dim As Integer i, c
For i = 1 To 10
    e = Iif(Even(i), "True ", "False")
    o = Iif(Odd(i),  "True ", "False")
    c = Collatz(i)
    Print Using "##: Even: &  Odd: &  Collatz: &"; i; e; o; c
Next i

Sleep
Output:
Similar to Julia/Python/Wren entry.

Haskell

A fix2 implementation in Haskell (as originally by Anders Kaseorg) is equivalent to fix*:

vfix lst = map ($vfix lst) lst

-- example usage: mutual recurrence relation of mod3

h1 [h1, h2, h3] n = if n == 0 then 0 else h2 (n - 1)
h2 [h1, h2, h3] n = if n == 0 then 1 else h3 (n - 1)
h3 [h1, h2, h3] n = if n == 0 then 2 else h1 (n - 1)
mod3 = head $ vfix [h1, h2, h3]

main = print $ mod3 <$> [0 .. 10]
Output:

[0,1,2,0,1,2,0,1,2,0,1]

Java

import java.util.List;

public final class VariadicFixedPointCombinator {	
	
	public interface CompletedFunction {
		boolean f(int x);
	}
	
	public interface FunctionFixed {
		CompletedFunction g();
	}
	
	public interface FunctionToBeFixed {
		CompletedFunction h(List<FunctionFixed> functionFixed);
		
		static List<FunctionFixed> k(List<FunctionToBeFixed> functionToBeFixed) {
			return List.of( () -> functionToBeFixed.get(0).h(k(functionToBeFixed)),
							() -> functionToBeFixed.get(1).h(k(functionToBeFixed)) );
		}
	}

	public static void main(String[] args) {
		List<FunctionToBeFixed> evenOddFix = List.of(
			functions -> n -> n == 0 ? true : functions.get(1).g().f(n - 1),
			functions -> n -> n == 0 ? false : functions.get(0).g().f(n - 1)
	    );
		
	    List<FunctionFixed> evenOdd = FunctionToBeFixed.k(evenOddFix);
	    
	    CompletedFunction even = evenOdd.get(0).g();
	    CompletedFunction odd = evenOdd.get(1).g();
	    
	    for ( int i = 0; i <= 9; i++ ) {
	    	System.out.println(i + ": Even: " + even.f(i) + ", Odd: " + odd.f(i));
	    }
	}
}
Output:
0: Even: true, Odd: false
1: Even: false, Odd: true
2: Even: true, Odd: false
3: Even: false, Odd: true
4: Even: true, Odd: false
5: Even: false, Odd: true
6: Even: true, Odd: false
7: Even: false, Odd: true
8: Even: true, Odd: false
9: Even: false, Odd: true

Julia

Translation of: Wren
let
    Y = (a) -> [((x) -> () -> x(Y(a)))(f) for f in a]

    even_odd_fix = [
        (f) -> (n) -> n == 0 || f[begin+1]()(n - 1),
        (f) -> (n) -> n != 0 && f[begin]()(n - 1),
    ]

    collatz_fix = [
        (f) -> (n, d) -> n == 1 ? d : f[isodd(n)+2]()(n, d + 1),
        (f) -> (n, d) -> f[begin]()(n ÷ 2, d),
        (f) -> (n, d) -> f[begin]()(3 * n + 1, d),
    ]

    evenodd = [f() for f in Y(even_odd_fix)]
    collatz = Y(collatz_fix)[begin]()

    for i = 1:10
        e = evenodd[begin](i)
        o = evenodd[begin+1](i)
        c = collatz(i, 0)
        println(lpad(i, 2), ": Even: $e  Odd: $o  Collatz: $c")
    end
end
Output:
 1: Even: false  Odd: true  Collatz: 0
 2: Even: true  Odd: false  Collatz: 1
 3: Even: false  Odd: true  Collatz: 7
 4: Even: true  Odd: false  Collatz: 2
 5: Even: false  Odd: true  Collatz: 5
 6: Even: true  Odd: false  Collatz: 8
 7: Even: false  Odd: true  Collatz: 16
 8: Even: true  Odd: false  Collatz: 3
 9: Even: false  Odd: true  Collatz: 19
10: Even: true  Odd: false  Collatz: 6

M2000 Interpreter

All functions for M2000 are variadics by design. When a function called, a special stack passed to that function, without any check from the caller point. Code on function side has the responsibility to do something with that data. If we pass more then these data disposed at the end of call.

The [] do two things, get the stack object (which have the parameters) and leave an empty one, then return the pointer to that object. The ! symbol look if we place an array or a stack object and place the items to the cascade call. Stacks alwaays consume with ! symbol.

So combinator y1 say: get f lambda and call it passing leftover parameters to it. This y1 works for finding factorials, and this only use one parameter for each call.

The next one checj for Empty stack, if stack is empty then return 0 else get one parameter and add a call to g, the f from combinator, and pass the leftover parameters. So if we have 100 parameters we call 100 times the lambda function (maximum ~3500 calls for current Interpreter, version 12). See the call without parameters, we get 0.

module Fixed_point_combinator_variadic{
	y1=lambda (f) ->f(f, ![])
	Print y1(lambda (g, n)->if(n=0->1, n*g(g, n-1)), 10)=3628800
	Print y1(lambda (g)->if(empty->0, number+g(g, ![])), 10, 20, 30)=60
	Print y1(lambda (g)->if(empty->0, number+g(g, ![])))=0
	Print y1(lambda (g)->if(empty->0, number+g(g, ![])), 10, 20, 30, 1, 2, 3)=66
}
Fixed_point_combinator_variadic

wikipedia.org about Fixed-point combinator

Module Fix_Point_Combinator{
	class fixer {
		function final fix(x) {
			=.f(x)
		}
	private:
		function f() {
		error "virtual"
		}
	}
	class fact as fixer {
	private:
		function final f(x as long){
			if x=0 then =1 else =x*.fix(x-1)
		}
	}
	Print fact()=>fix(5)=120
}
Fix_Point_Combinator

Perl

Translation of: Raku
# 20241003 Perl programming solution

use strict;
use warnings;

sub Y {
   my ($a) = @_;
   [ map { my $f = $_; sub { $f->(Y($a)) } } @$a ]
}

my $even_odd_fix = [
   sub { my ($f) = @_; sub { my ($n) = @_; $n == 0 || $f->[1]->()->($n - 1) } },
   sub { my ($f) = @_; sub { my ($n) = @_; $n != 0 && $f->[0]->()->($n - 1) } },
];

my $collatz_fix = [
   sub { my ($f) = @_; sub { my ($n,$d) = @_; $n == 1 ? $d : $f->[($n % 2) + 1]->()->($n, $d + 1) } },
   sub { my ($f) = @_; sub { my ($n,$d) = @_; $f->[0]->()->(int($n/2), $d)  } },
   sub { my ($f) = @_; sub { my ($n,$d) = @_; $f->[0]->()->(3 * $n + 1, $d) } },
];

my $even_odd = [ map { $_->() } @{Y $even_odd_fix} ];
my $collatz  = Y($collatz_fix)->[0]->();

for my $i (1..10) {
   my $e = $even_odd->[0]->($i);
   my $o = $even_odd->[1]->($i);
   my $c = $collatz->($i, 0);
   printf "%2d: Even: %5s  Odd: %5s  Collatz: %2d\n", $i, $e ? 'True' : 'False', $o ? 'True' : 'False', $c;
}

You may Attempt This Online!

Phix

Translation of Wren/Julia/JavaScript/Python... The file closures.e was added for 1.0.5, with the somewhat non-standard requirement of needing captures explicitly stated [and returned if updated], and invokable only via call_lambda(), not direct or [implicit] call_func().
Disclaimer: Don't ask me if this is a proper Y combinator, all I know for sure is it converts a set of functions into a set of closures, without recursion.

include builtins/closures.e  -- auto-include in 1.0.5+ (needs to be manually installed and included prior to that)

function Y(sequence a)
    for i,ai in a do
--      a[i] = define_lambda(ai,{a})
        a[i] = define_lambda(ai,{0})
    end for
    -- using {a} above would stash partially-updated copies,
    --  so instead use a dummy {0} and blat all at the end
    set_captures(a, {a})
    return a
end function

function e(sequence f, integer n)
    return n==0 or call_lambda(f[2],n-1)
end function

function o(sequence f, integer n)
    return n!=0 and call_lambda(f[1],n-1)
end function

function c1(sequence f, integer n, d)
    if n=1 then return d end if
    return call_lambda(f[2+odd(n)],{n,d+1})
end function

function c2(sequence f, integer n, d)
    return call_lambda(f[1],{floor(n/2),d})
end function

function c3(sequence f, integer n, d)
    return call_lambda(f[1],{3*n+1,d})
end function

sequence f2 = Y({e,o}),
         f3 = Y({c1,c2,c3})

object even_func = f2[1],
        odd_func = f2[2],
         collatz = f3[1]

for x=1 to 10 do
    bool bE = call_lambda(even_func,x),
         bO = call_lambda(odd_func,x)
    integer c = call_lambda(collatz,{x,0})
    printf(1,"%2d: even:%t, odd:%t, collatz:%d\n",{x,bE,bO,c})
end for
Output:
 1: even:false, odd:true, collatz:0
 2: even:true, odd:false, collatz:1
 3: even:false, odd:true, collatz:7
 4: even:true, odd:false, collatz:2
 5: even:false, odd:true, collatz:5
 6: even:true, odd:false, collatz:8
 7: even:false, odd:true, collatz:16
 8: even:true, odd:false, collatz:3
 9: even:false, odd:true, collatz:19
10: even:true, odd:false, collatz:6

Python

A re-translation of the Wren version.

Y = lambda a: [(lambda x: lambda: x(Y(a)))(f) for f in a]

even_odd_fix = [
    lambda f: lambda n: n == 0 or f[1]()(n - 1),
    lambda f: lambda n: n != 0 and f[0]()(n - 1),
]

collatz_fix = [
    lambda f: lambda n, d: d if n == 1 else f[(n % 2)+1]()(n, d+1),
    lambda f: lambda n, d: f[0]()(n//2, d),
    lambda f: lambda n, d: f[0]()(3*n+1, d),
]

even_odd = [f() for f in Y(even_odd_fix)]
collatz = Y(collatz_fix)[0]()

for i in range(1, 11):
    e = even_odd[0](i)
    o = even_odd[1](i)
    c = collatz(i, 0)
    print(f'{i :2d}: Even: {e}  Odd: {o}  Collatz: {c}')

Raku

Translation of: Julia
Translation of: Python
# 20240726 Raku programming solution

my &Y = -> \a { a.map: -> \f { -> &x { -> { x(Y(a)) } }(f) } }
             
my \even_odd_fix = -> \f { -> \n { n == 0  or f[1]()(n - 1) } },
                   -> \f { -> \n { n != 0 and f[0]()(n - 1) } };

my \collatz_fix = -> \f { -> \n, \d { n == 1 ?? d !! f[(n % 2)+1]()(n, d+1) } },
                  -> \f { -> \n, \d { f[0]()( n div 2, d ) } }, 
                  -> \f { -> \n, \d { f[0]()(   3*n+1, d ) } };

my \even_odd = Y(even_odd_fix).map: -> &f { f() }; # or { $_() }
my &collatz  = Y(collatz_fix)[0]();

for 1..10 -> \i {
   my ( \e, \o, \c ) = even_odd[0](i), even_odd[1](i), collatz(i, 0);
   printf "%2d: Even: %s  Odd: %s  Collatz: %s\n", i, e, o, c
}

You may Attempt This Online!

Wren

Library: Wren-fmt

This is a translation of the Python code here.

import "./fmt" for Fmt

var Y = Fn.new { |a|
    var ly = []
    for (x in a) {
        ly.add(Fn.new { |x| Fn.new { x.call(Y.call(a)) } }.call(x))
    }
    return ly
}

var evenOddFix = [
    Fn.new { |f| Fn.new { |n|
        if (n == 0) return true
        return f[1].call().call(n-1)
    }},

    Fn.new { |f| Fn.new { |n|
        if (n == 0) return false
        return f[0].call().call(n-1)
    }}
]

var collatzFix = [
    Fn.new { |f| Fn.new { |n, d|
        if (n == 1) return d
        return f[n%2 + 1].call().call(n, d+1)
    } },

    Fn.new { |f| Fn.new { |n, d| f[0].call().call((n/2).floor, d) } },

    Fn.new { |f| Fn.new { |n, d| f[0].call().call(3*n+1, d) } }
]

var evenOdd = Y.call(evenOddFix).map { |f| f.call() }.toList

var collatz = Y.call(collatzFix)[0].call()

for (x in 1..10) {
    var e = evenOdd[0].call(x)
    var o = evenOdd[1].call(x)
    var c = collatz.call(x, 0)
    Fmt.print("$2d: Even: $5s  Odd: $5s  Collatz: $n", x, e, o, c)
}
Output:
 1: Even: false  Odd:  true  Collatz: 0
 2: Even:  true  Odd: false  Collatz: 1
 3: Even: false  Odd:  true  Collatz: 7
 4: Even:  true  Odd: false  Collatz: 2
 5: Even: false  Odd:  true  Collatz: 5
 6: Even:  true  Odd: false  Collatz: 8
 7: Even: false  Odd:  true  Collatz: 16
 8: Even:  true  Odd: false  Collatz: 3
 9: Even: false  Odd:  true  Collatz: 19
10: Even:  true  Odd: false  Collatz: 6
Cookies help us deliver our services. By using our services, you agree to our use of cookies.