Использование замыканий и функций высших порядков в 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;
    


    Исходники к статье можно скачать здесь.
    Поделиться публикацией
    Реклама помогает поддерживать и развивать наши сервисы

    Подробнее
    Реклама
    Комментарии 12
    • +11
      Столько уже статей про ФП прочитал в стиле «как сложить 2+2 с помощью электронного микроскопа», а вот зачем оно нужно в реальных проектах(а оно там явно нужно, иначе люди бы не занимались этим), и когда его использовать в своих — до сих пор никто понятным языком не объяснил (
      • +2
        Гипотеза или (как здесь) гипотетическая возможность что-либо использовать — это скорее теория, а не практика.

        Ну а теория — она всегда впереди практики, теоретические выкладки обычно выглядят не особенно нужными и требуют проверки.
        Едва ли Гаусс использовал ежедневно свой метод решения СЛАУ, а Эйнштейн планировал создать ядерную бомбу или АЭС.
        Но это их не остановило в своих исследованиях. Было конечно море других гипотез, теорий, методов и предположений. Не прижившихся. Но сначала изобретают, открывают, определяют, а уж потом применяют. Не наоборот.

        Это я не к тому, что 1ntr0 — Эйнштейн, а лишь к тому, что без изложения теоретических возможностей практика никогда не состоится.
        • +2
          Вообще мне кажется оратор о другом.

          Вот вам в школе сразу формулу лапиталя и теорему коши давали или сначала про связь скорости и ускорения рассказывали?
          Или заставляли интегралы считать без рассказа о вычисления площади сложных фигур? Сразу давали заставляли уравнения максвелла считать или показывали опыты с магнитиками?

          Так и тут дается примеры реализации паттерноов фп на delphi. Здорово, но паттерн решает задачи. А постановки задачи тут и нет.
          • +3
            В нашей школе и нашем институте — сначала давали решать, а уже потом, когда-нибудь изредка что-нибудь на тему того, «а нафига вообще мы это пол года решаем/считаем». Никакой привязки к реальности. И это ни есть хорошо.
            • +1
              Всё так
        • 0
          А в Delphi обязательно определять алиасы для типов вида reference to function? Или пример с каррированием все-таки можно более внятно записать как
          function(....): reference to function(...): reference to ...
          ?
          • 0
            reference to function (): ResultType — это не тип. Это синтаксическая конструкция для объявления типа. Соответсвенно именно так написать нельзя.
            Другое дело, что можно было вместо своих алиасов использовать предопределенные TProc/TFunc
          • 0
            Все по делу, я только не понял, зачем было оборачивать TDictionary в TCache, ради ICache что ли?
            PS Особенно понравился пример именно с Memoize, он не самый очевидный в части использования лок. переменной род кэш :-)
            • 0
              род=под
              • 0
                При вызове Memoize происходит создание экземпляра TCache
                Cache := TCache<Integer, Double>.Create;
                

                Память выделяется, но где и когда ее освобождать? Обертка в интерфейс и объявление
                Cache: ICache
                

                позволяет организовать автоматический подсчет ссылок на экземпляр и автоматическое освобождение памяти из-под него, когда счетчик достигает нуля. Это происходит, когда Memoize выходит из области видимости.
                • +1
                  Я так и понял. А я себе сделал универсальную обертку для любого класса для случаев, когда очень хочется использовать класс в роли интерфейса (т.е. не заботясь о его уничтожении), и при этом не наследуясь от TInterfacedObject и не реализуя в каждом классе счетчик ссылок.
                  Собственно сам код
                  type
                    // Интерфейсная оболочка над объектом (используется, если нужно простой объект превратить в интерфейс)
                    IInterfacedContainer<T> = interface
                      function InnerObject: T;
                      function DetachInnerObject: T;
                    end;
                  
                    TInterfacedContainer<T: class> = class(TInterfacedObject, IInterfacedContainer<T>)
                    private
                      FInnerObject: T;
                    public
                      constructor Create(const aObject: T);
                      destructor Destroy; override;
                      function InnerObject: T;
                      function DetachInnerObject: T;
                    end;
                  
                  { TInterfacedContainer<T> }
                  
                  constructor TInterfacedContainer<T>.Create(const aObject: T);
                  begin
                    inherited Create;
                    FInnerObject := aObject;
                  end;
                  
                  destructor TInterfacedContainer<T>.Destroy;
                  begin
                    FInnerObject.Free;
                    inherited;
                  end;
                  
                  function TInterfacedContainer<T>.DetachInnerObject: T;
                  begin
                    Result := FInnerObject;
                    FInnerObject := nil;
                  end;
                  
                  function TInterfacedContainer<T>.InnerObject: T;
                  begin
                    Result := FInnerObject;
                  end;
                  
                  {Пример использования}
                  procedure Test;
                  var
                    vCont: IInterfacedContainer<TSomeObj>;
                  begin
                    vCont := TInterfacedContainer<TSomeObj>.Create(TSomeObj.Create);
                    with vCont.InnerObject do
                      {do something with TSomeObj}
                  end;
                  { После выхода из метода контейнер автоматически удалится вместе с объектом, который содержится внутри контейнера }
                  
                  

              • 0
                Здорово придумано! Спасибо.

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