Tag Archives: Erlang

Erlang Thursday – lists:filter/2

Today’s Erlang Thursday is on lists:filter/2.

lists:filter/2 takes two arguments, a predicate function and a list to iterate over. The return value is a list of items for which the predicate function returns true for that item.

lists:filter(fun (X) -> X rem 2 =:= 1 end, [1, 2, 3, 4, 5]).
% [1,3,5]
lists:filter(fun erlang:is_atom/1, [1, a, 3, {a, b}, 'World', foo]).
% [a,'World',foo]
lists:filter(fun (X) -> X > 0 end, [1, 0, -3, foo, -13, 43]).
% [1,foo,43]
lists:filter(fun (X) -> X > 0 end, []).                      
% []
lists:filter(fun (X) -> false end, [1, 2, 3, 4, 5]).
% []
lists:filter(fun (X) -> true end, [1, 2, 3, 4, 5]). 
% [1,2,3,4,5]

–Proctor

Erlang Thursday – httpc:request/1 and httpc:request/4

Today’s Erlang Thursday is on httpc:request/1 and httpc:request/4. The httpc module is Erlang’s HTTP 1.1 client, and the request function is a powerful way to make web requests using Erlang.

To start using the httpc module, you first have to make sure inets has been started.

inets:start().
% ok

httpc:request/1 takes one argument, and that is the URL, as a Erlang string, you want to make the request against.

httpc:request("http://www.example.com").
% {ok,{{"HTTP/1.1",200,"OK"},
%      [{"cache-control","max-age=604800"},
%       {"date","Thu, 22 Jan 2015 02:57:06 GMT"},
%       {"accept-ranges","bytes"},
%       {"etag",""359670651""},
%       {"server","ECS (ftw/FBE4)"},
%       {"content-length","1270"},
%       {"content-type","text/html"},
%       {"expires","Thu, 29 Jan 2015 02:57:06 GMT"},
%       {"last-modified","Fri, 09 Aug 2013 23:54:35 GMT"},
%       {"x-cache","HIT"},
%       {"x-ec-custom-error","1"}],
%      "<!doctype html>n<html>n<head>n    <title>Example Domain</title>nn    <meta ..."}}

httpc:request/1 is the equivalent of the httpc:request/4 function called as httpc:request(get, {Url, []}, [], []).

httpc:request(get, {"http://www.example.com", []}, [], []).
% {ok,{{"HTTP/1.1",200,"OK"},
%      [{"cache-control","max-age=604800"},
%       {"date","Thu, 22 Jan 2015 03:04:31 GMT"},
%       {"accept-ranges","bytes"},
%       {"etag",""359670651""},
%       {"server","ECS (ftw/FBE4)"},
%       {"content-length","1270"},
%       {"content-type","text/html"},
%       {"expires","Thu, 29 Jan 2015 03:04:31 GMT"},
%       {"last-modified","Fri, 09 Aug 2013 23:54:35 GMT"},
%       {"x-cache","HIT"},
%       {"x-ec-custom-error","1"}],
%      "<!doctype html>n<html>n<head>n    <title>Example Domain</title>nn    <meta ..."}}

You can specify headers as part of your request. For example, say we want to get DuckDuckGo’s page in Swedish in honor of Erlang being created by Ericsson. To do that, we add a tuple of {"Accept-Language", "sv"} to the headers list as part of the request.

httpc:request(get, {"http://duckduckgo.com/", [{"Accept-Language", "sv"}]}, [], []).
% {ok,{{"HTTP/1.1",200,"OK"},
%      [{"cache-control","max-age=1"},
%       {"connection","keep-alive"},
%       {"date","Thu, 22 Jan 2015 03:19:29 GMT"},
%       {"accept-ranges","bytes"},
%       {"etag",""54bfe2a8-1488""},
%       {"server","nginx"},
%       {"content-length","5256"},
%       {"content-type","text/html; charset=UTF-8"},
%       {"expires","Thu, 22 Jan 2015 03:19:30 GMT"}],
%      "<!DOCTYPE html>n<!--[if IEMobile 7 ]> <html lang="sv_SE" class="no-js iem7"> ..."}}

The third argument of httpc:request/4 is a list of HTTP option tuples. For example, you need to set timeouts on the response in order to avoid waiting on a response from an irresponsive or slow website because if it doesn’t respond in time, the requesting code needs to back off and try again later to avoid triggering the equivalent of a Denial of Service attack. In this case, I am specifying a timeout of 0, expressed in milliseconds, to ensure a timeout happens for illustrative purposes.

httpc:request(get, {"http://erlang.org/", []}, [{timeout, 0}], []).
{error,{failed_connect,[{to_address,{"erlang.org",80}},
                        {inet,[inet],timeout}]}}

As it’s final argument, httpc:request/4 takes a list of other options, these options are for how the Erlang side of things should work. Maybe you want to make a request asynchronously, and want to receive a message when it is complete. To do that you can specify an option tuple of {sync, false}.

{ok, RequestId} = httpc:request(get, {"http://www.example.com", []}, [], [{sync, false}]).
% {ok,#Ref<0.0.0.179>}
receive {http, {RequestId, Result}} -> Result after 500 -> error end.
% {{"HTTP/1.1",200,"OK"},
%  [{"cache-control","max-age=604800"},
%   {"date","Thu, 22 Jan 2015 03:08:41 GMT"},
%   {"accept-ranges","bytes"},
%   {"etag",""359670651""},
%   {"server","ECS (ftw/FBE4)"},
%   {"content-length","1270"},
%   {"content-type","text/html"},
%   {"expires","Thu, 29 Jan 2015 03:08:41 GMT"},
%   {"last-modified","Fri, 09 Aug 2013 23:54:35 GMT"},
%   {"x-cache","HIT"},
%   {"x-ec-custom-error","1"}],
%  <<"<!doctype html>n<html>n<head>n    <title>Example Domain</title>nn    <meta "...>>}

Or maybe you want to get the response body back as an Erlang binary instead of a string.

httpc:request(get, {"http://www.example.com", []}, [], [{body_format, binary}]).
% {ok,{{"HTTP/1.1",200,"OK"},
%      [{"cache-control","max-age=604800"},
%       {"date","Thu, 22 Jan 2015 03:58:55 GMT"},
%       {"accept-ranges","bytes"},
%       {"etag",""359670651""},
%       {"server","ECS (ftw/FBE4)"},
%       {"content-length","1270"},
%       {"content-type","text/html"},
%       {"expires","Thu, 29 Jan 2015 03:58:55 GMT"},
%       {"last-modified","Fri, 09 Aug 2013 23:54:35 GMT"},
%       {"x-cache","HIT"},
%       {"x-ec-custom-error","1"}],
%      <<"<!doctype html>n<html>n<head>n    <title>Example Domain</title>nn    <meta "...>>}}

This post just scratches the surface of what you can do with httpc:request/4, and I highly recommend checking out the Erlang documentation for the httpc module. For more examples and information, also check out the Erlang inets User Guide, and the chapter “HTTP Client“.

–Proctor

Erlang Thursday – erlang:apply/3

Today’s Erlang Thursday is on erlang:apply/3.

With functional languages we love to pass functions around as the first class citizens that they are. But sometimes we don’t know which function it is that we will need to invoke, causing us to be unsure of the arguments the function takes up front. If we knew, we could just invoke it as Fun(Arg1, Arg2, ..., ArgN), but that doesn’t work if we could get different functions of varying arities. Enter erlang:apply/3.

erlang:apply/3, takes the module name, the function name, and a list of the arguments to be passed to the function. The function passed to erlang:apply/3 must also have been exported, otherwise an error will be raised.

erlang:apply(lists, max, [[7, 3, 5, 11, 1]]).
% 11
erlang:apply(lists, merge, [[1, 2, 3], [a, b, c]]).        
% [1,2,3,a,b,c]
erlang:apply(lists, merge, [[1, 2, 3], [a, b, c]]).           
% [1,2,3,a,b,c]

The Erlang documentation points out that this should be used only when the number of arguments is not known at compile time. Otherwise we could just do the a normal function invocation, even if passed a anonymous function.

fun lists:max/1([1, 2, 3, 4]).
4

The erlang module also includes a version erlang:apply/2 that takes a function as it’s first argument, and a list of the arguments to be passed to the function as it’s second argument.

erlang:apply(fun lists:merge/2, [[1, 2, 3], [a, b, c]]).
% [1,2,3,a,b,c]

While erlang:apply/2 and erlang:apply/3 will not be part of your common usage, there are cases where it is needed, like last weeks timer:tc. And though your usage of it will likely be rare, it is still good to know that you have it handy.

–Proctor

Erlang Thursday – timer:tc/3

Today’s Erlang Thursday is on timer:tc/3.

I am sure we have all written some timing code where we capture the current time, do something, capture the current time again and then find the difference to find out how long something took to execute. In Erlang, that generally looks something like the following:

Time1 = now().
% {1420,519186,111375}
timer:sleep(4000).  % Do something
% ok
Time2 = now().
% {1420,519190,118280}
timer:now_diff(Time2, Time1).
% 4006905

Note that we have to use timer:now_diff/2, since the now() function returns the timestamp as a tuple, and we can’t just do normal subtraction on that tuple like we might be able to in other languages.

Of course as good “engineers”, we know that since we need to do timings in various places of the app we can just create our own function to do that, and have that live in just one place.

The downside is: the wise people on the Erlang language team have done that for us already and provided it in the form of timer:tc/3.

timer:tc/3 takes the module name, function name, and a list of the arguments to be passed to the function. And since we usually want the result of the function we are calling, in addition to the timing, the return value is a tuple of the time in microseconds, and the result of applying the function passed to timer:tc/3.

timer:tc(timer, sleep, [4000]). 
% {4003097,ok}
timer:tc(lists, foldl, [fun(X, Accum) -> X + Accum end, 0, lists:seq(1, 2000000)]). 
% {5099481,2000001000000}

There is also timer:tc/1 which takes just a function and applies it, and timer:tc/2 which takes a function and applies it with the given arguments.

timer:tc(fun() -> lists:foldl(fun(X, Accum) -> X + Accum end, 0, lists:seq(1, 2000000)) end).
% {5709293,2000001000000}
timer:tc(fun lists:foldl/3, [fun(X, Accum) -> X + Accum end, 0, lists:seq(1, 2000000)]).
% {5766480,2000001000000}

–Proctor

Erlang Thursday – lists:any/2

Today’s Erlang Thursday function of the week is lists:any/2.

lists:any/2 takes a predicate function as the first argument, and a list to iterate over as its second argument. lists:any/2 returns true if the predicate function returns true for any of the elements in the given list, otherwise, lists:any/2 returns false.

lists:any(fun erlang:is_atom/1, [1, 2, 3, 4, 5, 6, 7]).
% false
lists:any(fun erlang:is_atom/1, [1, 2, 3, 4, a, 6, 7]).
% true
lists:any(fun erlang:is_atom/1, [{1, 2}, 3, 4, a, 6, 7]). 
% true
lists:any(fun(X) -> X rem 2 == 1 end, [1, 2, 4]).
% true
lists:any(fun(X) -> X rem 2 == 1 end, [0, 2, 4]).    
% false

lists:any/2 is eager, and will return with a result of true as soon as it is found, and will ignore processing the rest of the list.

timer:tc(lists, any, [fun(X) -> X rem 2 == 1 end, lists:seq(2, 200000, 2)]).
% {248410,false}
timer:tc(lists, any, [fun(X) -> X rem 2 == 0 end, lists:seq(2, 200000, 2)]).
% {13,true}

The lists module also contains a function lists:all/2, similar to lists:any/2, but checks if the predicate function returns true for every element in the supplied list.

lists:all(fun erlang:is_number/1, [1, 2, 3, 4, a, 6, 7]).
% false
lists:all(fun erlang:is_number/1, [1, 2, 3, 4, 5, 6, 7]).
% true

lists:all/2 is also eager, and will return with a result of false as soon as it is found, and will ignore processing the rest of the list.

timer:tc(lists, all, [fun(X) -> X rem 2 == 0 end, lists:seq(2, 200000, 2)]).
% {235276,true}
timer:tc(lists, all, [fun(X) -> X rem 2 == 1 end, lists:seq(2, 200000, 2)]).
% {14,false}

–Proctor

Erlang Thursday – lists:partition/2

Today’s Erlang Thursday is lists:partition/2.

lists:partition/2 takes two arguments, a predicate function that will be called for every entry in the list, and returns a boolean value. The second argument to lists:partition/2 is the list to be partitioned.

lists:partition/2 returns a two-tuple, with the first item in the tuple being the list of those items for which the predicate function returns true. The second item in the tuple is a list of those items for which the predicate function returned false.

lists:partition(fun(X) -> X rem 2 == 1 end, [1, 2, 3, 4, 5, 6, 7]).
% {[1,3,5,7],[2,4,6]}
lists:partition(fun(X) -> X rem 3 == 0 end, [1, 2, 3, 4, 5, 6, 7]).
% {[3,6],[1,2,4,5,7]}
lists:partition(fun erlang:is_atom/1, [a, 1, [b, c], 'B', fun lists:sum/1]).
% {[a,'B'],[1,[b,c],#Fun<lists.sum.1>]}
lists:partition(fun erlang:is_atom/1, [a, 1, {b, [z]}, 'B', fun lists:sum/1]).
% {[a,'B'],[1,{b,[z]},#Fun<lists.sum.1>]}
lists:partition(fun erlang:is_atom/1, []).                                    
% {[],[]}

–Proctor

Erlang Thursday – lists:zip/2

Today’s Erlang Thursday is lists:zip/2.

lists:zip/2 returns a new list of two-tuples, from the corresponding elements of the two lists passed as arguments.

lists:zip([a, b, c, d], [1, 2, 3, 4]).
% [{a,1},{b,2},{c,3},{d,4}]
lists:zip([a, b, c, d], [{1, 3}, {2, 5}, {3, 7}, {4, 11}]).
% [{a,{1,3}},{b,{2,5}},{c,{3,7}},{d,{4,11}}]
lists:zip([a, b], [fun lists:map/3, fun lists:foldl/3]).
% [{a,#Fun<lists.map.3>},{b,#Fun<lists.foldl.3>}]

If the lists are not of the same length a function clause match exception is thrown.

lists:zip([a, b, c, d], [1, 2, 3]).                        
% ** exception error: no function clause matching lists:zip([d],[]) (lists.erl, line 385)
%      in function  lists:zip/2 (lists.erl, line 385)
%      in call from lists:zip/2 (lists.erl, line 385)
lists:zip([a, b, c], [1, 2, 3, 4]).                        
% ** exception error: no function clause matching lists:zip([],[4]) (lists.erl, line 385)
%      in function  lists:zip/2 (lists.erl, line 385)
%      in call from lists:zip/2 (lists.erl, line 385)

There is also a 3-arity version of the zip function lists:zip3/3, which behaves like lists:zip/2 but takes three lists as arguments instead of two.

lists:zip3([a, b, c, d], [1, 2, 3, 4], ["alpha", "bravo", "charlie", "delta"]).         
% [{a,1,"alpha"},{b,2,"bravo"},{c,3,"charlie"},{d,4,"delta"}]

If you need to combine the arguments in a different manner, you can use lists:zipwith/3, or lists:zipwith3/4, each of which takes as the first argument a 2-arity combining function.

lists:zipwith(fun(X, Y) -> X * Y end, [1, 2, 3, 4], [2, 3, 4, 5]).
% [2,6,12,20]
lists:zipwith(fun(X, Y) -> X + Y end, [1, 2, 3, 4], [2, 3, 4, 5]).                                                
% [3,5,7,9]
lists:zipwith3(fun(X, Y, Z) -> X * Y * Z end, [1, 2, 3, 4], [2, 3, 4, 5], [4, 3, 2, 1]).
% [8,18,24,20]
lists:zipwith3(fun(X, Y, Z) -> {{X, Y}, Z} end, [a, b, c, d], [1, 2, 3, 4], ["alpha", "bravo", "charlie", "delta"]).
% [{{a,1},"alpha"},
%  {{b,2},"bravo"},
%  {{c,3},"charlie"},
%  {{d,4},"delta"}]

–Proctor

Erlang Thursday – lists:foldl/3 and lists:foldr/3

Today’s Erlang Thursday is lists:foldl/3 and lists:foldr/3.

lists:foldl/3 is Erlang’s version of the reduce function. lists:foldl/3 takes a function, an initial accumulator value, and a list, and returns a single value.

The first argument given to foldl is a function that takes two arguments, the item currently iterating over, and the accumulated value. The result of applying this function is used as new new value for the accumulator for the following item, or if no items are left it becomes the result of foldl.

The next argument to lists:foldl/3 is an initial value of the accumulator. This is different than some other languages, as those languages will take the initial value for the accumulator as an optional value and use the first item to be traversed as the default value for the accumulator. But in Erlang an initial value for the accumulator is a required argument to both lists:foldl/3 and lists:foldr/3.

The third, and last, argument to foldl is the list to iterate over.

lists:foldl(fun(X, Sum) -> Sum + X end, 0, [1, 2, 3, 4, 5]).
% 15
lists:foldl(fun(X, Product) -> Product * X end, 1, [1, 2, 3, 4, 5]).
% 120
lists:foldl(fun(X, Accum) -> io:format("~p ", [X]) end, void, [1, 2, 3, 4, 5]).
% 1 2 3 4 5 ok
lists:foldl(fun(X, Accum) -> io:format("~p ", [X]), Accum end, void, [1, 2, 3, 4, 5]).
% 1 2 3 4 5 void
lists:foldl(fun(X, Accum) -> Accum + X end, 1, []).               
% 1
lists:foldl(fun(X, Result) -> lists:umerge(Result, X) end, [], [[1, 2, 3], [3, 5, 8], [11, 13, 17]]).
% [1,2,3,5,8,11,13,17]

The Erlang lists module also contains the function foldr/3 which traverses the list from left to right, or from the last item in the list to the first.

lists:foldr(fun(X, Accum) -> io:format("~p ", [X]), Accum end, void, [1, 2, 3, 4, 5]).
% 5 4 3 2 1 void
lists:foldr(fun(X, Accum) -> Accum + X end, 1, []).
% 1

The Erlang documentation points out that lists:foldl/3 is generally preferable over lists:foldr/3 because lists:foldl/3 is tail recursive, where lists:foldr/3 is not.

Erlang Thursday – lists:map/2

Today’s Erlang Thursday features lists:map/2.

lists:map/2 takes two arguments, a “mapping” function which takes a single argument, and a list of Erlang terms. The result is a new list of items that is the result of mapping the function applied to each value in the original list.

lists:map(fun(X) -> X + 1 end, [1, 2, 3, 4]).
% [2,3,4,5]
lists:map(fun(X) -> X * X end, [1, 2, 3, 4]).
% [1,4,9,16]

Because strings in Erlang are just lists of integers, you can map against strings as well.

lists:map(fun(X) -> X - 1 end, "IBM").
% "HAL"

On Functions in Erlang

If you look at the first example above, you see that the first argument we are passing is fun(X) -> X + 1 end. This is Erlang’s syntax for an anonymous function. An anonymous function takes the form:

fun(Args1) OptionalGuardClause1 ->
        Expression1, Expression2;
   (Args2) OptionalGuardClause2 ->
        Expression3, Expression4;
   (Args3) OptionalGuardClause3 ->
        Expression5, Expression6;
end

Because we have the power of normal functions, except for being able to recursively call an anonymous function before version 17.0, we can use anonymous functions with multiple clauses when passing to map.

lists:map(fun(X) when is_atom(X) -> atom; (X) -> nil end, [1, x, {x}, [], 'B']).
[nil,atom,nil,nil,atom]

Passing Existing Named Functions to lists:map/1

While in some cases an inline anonymous function may work, many times we would want to have a named function for clarity. We can pass named functions to map by using the qualified name of the function – module:function_name/arity – prefaced with fun. The examples below use math:log10/1 and erlang:is_atom/1 to demonstrate.

lists:map(fun math:log10/1, [1, 10, 100, 1000, 10000]).
[0.0,1.0,2.0,3.0,4.0]
lists:map(fun erlang:is_atom/1, [1, x, {x}, [], 'B']).
[false,true,false,false,true]

–Proctor

Erlang Thursday – lists:flatten/1

Today’s Erlang Thursday function is lists:flatten/1.

lists:flatten/1 flattens out an arbitrarily deep list of Erlang terms, into a “flattened” list.

lists:flatten([]).
% []
lists:flatten([a, b, c]).
% [a,b,c]
lists:flatten([a, b, [1, [x, y], 3], c]).
% [a,b,1,x,y,3,c]
lists:flatten([a, b, [1, [x, {some, tuple}], 3], c]).    
% [a,b,1,x,{some,tuple},3,c]

Be warned though, it flattens out all lists, as seen here

lists:flatten([a, "foo", b]).    
% [a,102,111,111,b]

You get the above lists with numbers in it, because under the covers, a string is just a list of integers, so you get the ASCII character codes for the letters f and o in "foo".

If you want the string to “remain”, you need to use the string as a binary type like this:

lists:flatten([a, <<"foo">>, b]).                       
% [a,<<"foo">>,b]

And as a bonus, there is also a lists:flatten/2, that takes a list to flatten, and another argument tail, which is the value to append to the newly flattened list.

lists:flatten([a, [1, [b, [2]]]], [x, y, z]).
% [a,1,b,2,x,y,z]

–Proctor