Использование замыканий и функций высших порядков в Delphi

Данная статья является продолжением предыдущей публикации, которая была посвящена анонимным методам. В этот раз речь пойдет о примерах использования функций высших порядков и замыканий, показавшихся автору интересными.

Delphi не является языком функционального программирования, но тот факт, что программы на нем могут манипулировать функциями как объектами означает, что в Delphi можно использовать приемы функциональной парадигмы. Цель статьи — не подтолкнуть к использованию этого стиля, но обозначить некоторые примеры и возможности.

Конструирование функций

Функции высшего порядка (ФВП) – это функции, которые оперируют функциями, принимая одну или более функций и возвращая новую функцию.
Следующий пример показывает, как с помощью ФВП можно конструировать другие функции.

type
  TRef<AT, RT> = reference to function(X: AT): RT; 
var
  Negate: TRef<TRef<Integer, Boolean>, TRef<Integer, Boolean>>;
  IsOdd, IsEven: TRef<Integer, Boolean>;
begin
  // Пусть имеется функция, определяющая нечетные числа
  IsOdd := function(X: Integer): Boolean
    begin
      Result := X mod 2 <> 0;
    end;

  // Определим порождающую функцию
  Negate := function(F: TRef<Integer, Boolean>): TRef<Integer, Boolean>
    begin
      Result := function(X: Integer): Boolean
        begin
          Result := not F(X);
        end;
    end;

  // Теперь сконструируем новую функцию
  IsEven := Negate(IsOdd);  

  WriteLn(IsOdd(4)); // => False
  WriteLn(IsEven(4)); // => True 
end;

Функция Negate в примере выше, является ФВП, потому что она принимает функцию IsOdd в виде аргумента и возвращает новую функцию IsEven, которая передает свои аргументы Negate и возвращает логическое отрицание значения, возвращаемого функцией IsOdd.

Так как использование обобщенных типов не способствует ясности изложения, в последующих примерах будем по возможности их избегать.

Композиция функций

Ниже приводится пример еще одной, более универсальной функции, которая принимает две функции, F и G, и возвращает новую функцию, которая возвращает результат F(G()).

type
  TOneArgRef = reference to function(X: Single): Single;
  TTwoArgRef = reference to function(X, Y: Single): Single;
  TCompose = reference to function(F: TOneArgRef; G: TTwoArgRef): TTwoArgRef;
var
  Compose: TCompose;
  Square: TOneArgRef;
  Half: TOneArgRef;
  Sum: TTwoArgRef;
  SquareOfSum: TTwoArgRef;
  HalfSum: TTwoArgRef;
begin
  // Определим функцию высшего порядка "Композиция"
  Compose := function(F: TOneArgRef; G: TTwoArgRef): TTwoArgRef
    begin
      Result := function(X, Y: Single): Single
        begin
          Result := F(G(X, Y));
        end;
    end;

  // Определим базовые функции:
  // 1. возвращает квадрат аргумента
  Square := function(X: Single): Single
    begin
      Result := X * X;
    end;
  // 2. Возвращает половину аргумента
  Half := function(X: Single): Single
    begin
      Result := X / 2;
    end;
  // 3. возвращает сумму двух аргументов
  Sum := function(X, Y: Single): Single
    begin
      Result := X + Y;
    end;

  // Определяем композицию "квадрат суммы"
  SquareOfSum := Compose(Square, Sum);
  // Определяем композицию "полусумма"
  HalfSum := Compose(Half, Sum);

  WriteLn(SquareOfSum(2.0, 3.0)); // => 25.0
  WriteLn(HalfSum(3.0, 7.0)); // => 5.0
end;

Здесь функция Compose вычисляет F(G(X, Y)). Возвращаемая функция передает все свои аргументы функции G, затем передает значение, полученное от G, функции F и возвращает результат вызова F.

Частичное применение

Этот термин описывает преобразование функции с несколькими аргументами в функцию, которая принимает меньшее количество аргументов, при этом значения для опущенных аргументов задаются заранее. Этот прием вполне адекватен своему названию: он «частично применяет» некоторые аргументы функции, возвращая функцию, принимающую остающиеся аргументы.
Функция BindLeft в примере ниже берет функцию Calc, принимающую n аргументов, связывает первые k из них с наперед заданными значениями и возвращает функцию Partial, которая может принять (n-k) аргументов (первые k аргументов будут уже применены к ней).

type
  TManyArgRef = reference to function(Args: TArray<Double>): Double;
  TBindRef = reference to function(Args: TArray<Double>; F: TManyArgRef): TManyArgRef;
var
  BindLeft: TBindRef;
  Calc, Partial: TManyArgRef;
begin
  // Определим функцию, которая применяет свои аргументы Args
  // к функции F слева.
  BindLeft := function(Args: TArray<Double>; F: TManyArgRef): TManyArgRef
    var
      StoredArgs: TArray<Double>;
    begin
      StoredArgs := Args;
      Result := function(Args: TArray<Double>): Double
        begin
          Result := F(StoredArgs + Args);
        end;
    end;

  // Функция принимает массив аргументов
  // и выполняет произвольные вычисления
  Calc := function(A: TArray<Double>): Double
    begin
      Result := A[0] * (A[1] - A[2]);
    end;

  // Частичное применение слева
  Partial := BindLeft([2, 3], Calc); // Фиксируем первый и второй аргумент
  WriteLn(Partial([4])); // => -2.0
  // Вызов Partial эквивалентен вызову Calc([2, 3, 4]) 
end;

Здесь интересен момент, когда после вызова BindLeft локальная переменная StoredArgs не прекращает свое существование и используется далее, сохраняя в себе значения аргументов, которые потом используются при вызове Partial и передаются в Calc. Этот эффект называется замыканием. При этом каждый вызов BindLeft будет порождать новые «экземпляры» StoredArgs. Замыкания использовались и в предыдущих примерах, когда в них сохранялись аргументы ФВП.
Определить частичное применение справа можно следующим образом:

  BindRight := function(Args: TArray<Double>; F: TManyArgRef): TManyArgRef
    var
      StoredArgs: TArray<Double>;
    begin
      StoredArgs := Args;
      Result := function(Args: TArray<Double>): Double
        begin
          Result := F(Args + StoredArgs); // Здесь отличие
        end;
    end;

Карринг

В то время как частичное применение преобразует функцию с n параметрами в функцию с n-k параметрами, применяя k аргументов, карринг декомпозирует функцию на функции от одного аргумента. Мы не передаем никаких дополнительных аргументов в метод Curry, кроме преобразуемой функции:

• Curry(F) возвращает функцию F1, такую что...
• F1(A) возвращает функцию F2, такую что...
• F2(B) возвращает функцию F3, такую что...
• F3(С) вызывает F(A, B, C)

type
  TOneArgRef = reference to function(X: Double): Double;
  TThreeArgRef = reference to function(X, Y, Z: Double): Double;
  TSecondStepRef = reference to function(X: Double): TOneArgRef;
  TFirstStepRef = reference to function(X: Double): TSecondStepRef;
  TCurryRef = reference to function(F: TThreeArgRef): TFirstStepRef;
var
  Curry: TCurryRef;
  Calc: TThreeArgRef;
  F1: TFirstStepRef;
  F2: TSecondStepRef;
  F3: TOneArgRef;
  Re: Double;
begin
  // Определим каррирующую функцию для функции трех аргументов
  Curry := function(F: TThreeArgRef): TFirstStepRef
    begin
      Result := function(A: Double): TSecondStepRef
        begin
          Result := function(B: Double): TOneArgRef
            begin
              Result := function(C: Double): Double
                begin
                  Result := F(A, B, C);
                end;
            end;
        end;
    end;

  // Определим функцию от трех аргументов,
  // выполняющую произвольные вычисления
  Calc := function(A, B, C: Double): Double
    begin
      Result := A + B + C;
    end;

  // Теперь вычислим значение функции Calc, используя карринг
  F1 := Curry(Calc);
  F2 := F1(1);
  F3 := F2(2);
  Re := F3(3);

  WriteLn(Re); // => 6.0
end;

Чуть более компактно выглядит обобщенный вариант Curry.

type
  TRef<AT, RT> = reference to function(Args: AT): RT;
  TCalc<T> = reference to function(X, Y, Z: T): T;
var
  Curry: TRef<TCalc<Double>,TRef<Double,TRef<Double,TRef<Double,Double>>>>;
  Calc: TCalc<Double>;
begin
  // Определение каррирующей функции
  Curry := function(F: TCalc<Double>): TRef<Double,TRef<Double,TRef<Double,Double>>>
    begin
      Result := function(A: Double): TRef<Double,TRef<Double,Double>>
        begin
          Result := function(B: Double): TRef<Double,Double>
            begin
              Result := function(C: Double): Double
                begin
                  Result := F(A, B, C);
                end;
            end;
        end;
    end;
  // Определение каррируемой функции
  Calc := function(A, B, C: Double): Double
  begin
    Result := A + B + C;
  end;
  // Результат
  WriteLn(Curry(Calc)(1)(2)(3)); // => 6.0
end;

Мемоизация

Мемоизованная функция — это функция, которая сохраняет ранее вычисленные результаты. Другими словами, для функции создаётся таблица результатов, и, будучи вычисленным при определённых значениях параметров, результат заносится в эту таблицу. В дальнейшем результат берётся из данной таблицы. Эта техника позволяет за счёт использования дополнительной памяти ускорить работу программы. Разумеется, мемоизируемая функция должна работать без побочных эффектов и ей желательно иметь дискретную область определения.
В следующем примере демонстрируется функция Memoize высшего порядка, которая принимает функцию в виде аргумента и возвращает ее мемоизованную версию.

type
  TRef = reference to function(X: Integer): Double;
  TMemoize = reference to function(F: TRef): TRef;
var
  Memoize: TMemoize;
  Calc: TRef;
  MemoizedCalc: TRef;
begin
  // Определим Memoize
  Memoize := function(F: TRef): TRef
    var
      Cache: ICache<Integer, Double>;
    begin
      Cache := TCache<Integer, Double>.Create;
      Result := function(X: Integer): Double
        begin
          // Если в кэше нет сохраненных значений...
          if not Cache.TryGetValue(X, Result) then
            begin                                                      
              Result := F(X); // ...придется вычислить функцию
              Cache.Add(X, Result); // и запомнить результат
            end;
        end;
    end;

  // Функция, производящая относительно долгие вычисления
  Calc := function(X: Integer): Double
    var
      I: Integer;
    begin
      Result := 0;
      for I := 1 to High(Word) do
        Result := Result + Ln(I) / Sin(I) * X;
    end;

  // Мемоизованный вариант функции Calc
  MemoizedCalc := Memoize(Calc);
end;

Функция Memoize создает объект TCache для использования в качестве кэша и присваивает его локальной переменной, благодаря чему он остается доступным (через замыкание) только для возвращаемой функции. Возвращаемая функция преобразует свой аргумент в ключ. Если значение присутствует в кэше, оно просто возвращается в качестве результата. В противном случае вызывается оригинальная функция, вычисляющая значение для заданного аргумента; полученное значение помещается в кэш и возвращается.

Реализация кэша

interface

uses
  Generics.Collections;

type
  // Интерфейсная обертка для автоматического освобождения объекта
  ICache<TKey, TValue> = interface
    function TryGetValue(Key: TKey; out Value: TValue): Boolean;
    procedure Add(Key: TKey; Value: TValue);
  end;

  TCache<TKey, TValue> = class(TInterfacedObject, ICache<TKey, TValue>)
  private
    FDictionary: TDictionary<TKey, TValue>;
  public    
    constructor Create;
    destructor Destroy; override;
    function TryGetValue(Key: TKey; out Value: TValue): Boolean;
    procedure Add(Key: TKey; Value: TValue);
  end;

implementation

constructor TCache<TKey, TValue>.Create;
begin
  FDictionary := TDictionary<TKey, TValue>.Create;
end;

destructor TCache<TKey, TValue>.Destroy;
begin
  FDictionary.Free;
  inherited;
end;

procedure TCache<TKey, TValue>.Add(Key: TKey; Value: TValue);
begin
  FDictionary.Add(Key, Value);
end;

function TCache<TKey, TValue>.TryGetValue(Key: TKey; out Value: TValue): Boolean;
begin
  Result := FDictionary.TryGetValue(Key, Value);
end;

Программа с мемоизованной функцией, периодически вызываемой с одинаковыми аргументами, должна выполняться быстрее, чем аналогичная программа без применения мемоизации. Проверим разницу:

uses
  SysUtils, DateUtils;
var
  I: Integer;
  Time: TDateTime;
  Ms1, Ms2: Int64;
  Res1, Res2: Double;
begin
  Res1 := 0;
  Res2 := 0;
  // До мемоизации
  Time := Now;
  for I := 1 to 1000 do
    Res1 := Res1 + Calc(I mod 100);
  Ms1 := MilliSecondsBetween(Now, Time);

  // После мемоизации
  Time := Now;
  for I := 1 to 1000 do
    Res2 := Res2 + MemoizedCalc(I mod 100);
  Ms2 := MilliSecondsBetween(Now, Time);

  WriteLn(Res1 = Res2); // => True
  WriteLn(Ms1 > Ms2); // => True
end;

Генераторы

Здесь под генератором понимается ФВП, которая возвращает функцию, вызов которой приводит к получению следующего члена некоторой последовательности. В примере ниже создаются два генератора: для последовательности Фибоначчи и генератор факториалов. Предыдущие элементы генераторов запоминаются в замыкании.

type
  TRef = reference to function: Cardinal;
  TGenRef = reference to function: TRef;
var
  FibGen, FactGen: TGenRef;
  FibVal, FactVal: TRef;
  I: Integer;
begin
  // Функция-генератор, создающая последовательность чисел Фибоначчи
  FibGen := function: TRef
  var
    X, Y: Cardinal;
  begin
    X := 0; Y := 1;
    Result := function: Cardinal
    begin
      Result := Y;
      Y := X + Y;
      X := Result;
    end;
  end;

  // Функция-генератор, создающая последовательность факториалов
  FactGen := function: TRef
  var
    X, Y: Cardinal;
  begin
    X := 1; Y := 1;
    Result := function: Cardinal
    begin
      Result := Y;
      Y := Y * X;
      Inc(X);
    end;
  end;

  // Вызов создающей функции-генератора и получение собственно генератора.
  // Тот редкий случай в Delphi, когда необходимо поставить круглые скобки.
  FibVal := FibGen();
  FactVal := FactGen();

  for I := 1 to 10 do
    WriteLn(FibVal, #9, FactVal);
end;

Польза генераторов заключается в том, что для вычисления каждого следующего элемента не требуется вычислять всю последовательность с самого начала. Генераторы позволяют работать даже с бесконечными последовательностями, но они обеспечивают только последовательный доступ к своим элементам и не позволяют обращаться к своим элементам по индексу: чтобы получить n-e значение придется выполнить n-1 итераций.

Отложенные вычисления

Генераторы бывает удобно использовать для последовательной обработки данных — элементов списка, строк текста, лексем в лексическом анализаторе и т.д. Генераторы можно объединять в цепочки, подобно конвейеру команд в Unix. Самое интересное в этом подходе заключается в том, что он следует принципу отложенных вычислений: значения «извлекаются» из генератора (или из конвейера) по мере необходимости, а не все сразу. Эту особенность демонстрирует следующий пример, в котором исходный текст фильтруется, построчно проходя через цепочку генераторов.

type
  TStringRef = reference to function: string;
  TEachLineRef = reference to function(S: string): TStringRef;
  TArgMap = reference to function(S: string): string;
  TMap = reference to function(A: TStringRef; F: TArgMap): TStringRef;
  TArgSelect = reference to function(S: string): Boolean;
  TSelect = reference to function(A: TStringRef; F: TArgSelect): TStringRef;

const
  // Исходный текст, который нужно фильтровать
  TEXT = '#comment ' + sLineBreak + '' + sLineBreak +
    '  hello' + sLineBreak + ' world ' + sLineBreak +
    ' quit ' + sLineBreak + ' unreached';
var
  EachLine: TEachLineRef;
  Map: TMap;
  Select: TSelect;
  Lines, Trimmed, Nonblank: TStringRef;
  S: string;
begin
  // Генератор, возвращающий строки текста по одной.
  EachLine := function(S: string): TStringRef
  begin
    Result := function: string
    begin
      Result := S.Substring(0, S.IndexOf(sLineBreak));
      S := S.Substring(S.IndexOf(sLineBreak) + 1);
    end;
  end;

  // ФВП, возвращает функцию, результат которой - применение F к A
  Map := function(A: TStringRef; F: TArgMap): TStringRef
  begin
    Result := function: string
    begin
      Result := F(A);
    end;
  end;

  // Функция-генератор, возвращает значение A, если F(A) = True
  Select := function(A: TStringRef; F: TArgSelect): TStringRef
  begin
    Result := function: string
    begin
      repeat
        Result := A;
      until F(Result);
    end;
  end;

  // Сконструируем конвейер генераторов для обработки текста:
  // Сначала разбить текст на строки
  Lines := EachLine(TEXT);
  // Затем удалить начальные и конечные пробелы в каждой строке
  Trimmed := Map(Lines, function(S: string): string
    begin
      Result := S.Trim;
    end);
  // Наконец, игнорировать пустые строки и комментарии
  Nonblank := Select(Trimmed, function(S: string): Boolean
    begin
      Result := (S.Length > 0) and (S[1] <> '#');
    end);
  // Теперь извлечь отфильтрованные строки из конвейера и обработать их,
  // остановиться, если встретится строка 'quit'
  repeat
    S := Nonblank;
    if S = 'quit' then Break;
    WriteLn(S);
  until False;
end;

Исходники к статье можно скачать здесь.