RabbitFarm

2020-11-08

Command Line Arguments with SWI_Prolog’s library(optparse)

SWI-Prolog has a nice library which allows you to pass arguments on the command line to your Prolog programs. Here are a couple of example of it’s use done with the two parts of Perl Weekly Challenge 085 implemented in Prolog.

Part 1

You are given an array of real numbers greater than zero. Write a script to find if there exists a triplet (a,b,c) such that 1 < a+b+c < 2. Print 1 if you succeed otherwise 0.

Solution


:- use_module(library(optparse)).
/*
    You are given an array of real numbers greater than zero.
    Write a script to find if there exists a triplet (a,b,c) 
    such that 1 < a+b+c < 2. Print 1 if you succeed otherwise 0.
*/
opts_spec(
    [
        [opt(numbers), 
        default([1.2, 0.4, 0.1, 2.5]),
        longflags([numbers])]
    ]).

ch_1(L):-
    member(A, L),
    member(B, L),
    member(C, L),
    A =\= B,
    B =\= C,
    A =\= C,
    D is A + B + C,
    D > 1,
    D < 2,
    writeln(1).
    
ch_1(_):-  
    writeln(0).
    
main:-
    opts_spec(OptsSpec),
    opt_arguments(OptsSpec, [numbers(N)], _AdditionalArguments),
    ch_1(N),
    halt.

Sample Run


$ swipl -s ch-1.p -g main --numbers="[1.0, 0.2, 3.4, 0.1]"
1
$ swipl -s ch-1.p -g main --numbers="[1.0, 1.2, 3.4, 0.1]"
0

Notes

You can see from the Sample Run that we are passing a Prolog list as a command line argument. To avoid conflicts with the shell trying to interpret our square brackets and commas we put the list itself in quotes. But how does Prolog know what --numbers means?

To use library(optparse) you must define a specification for each of your command line arguments that you expect to take. Here we just have one. The line opt(numbers) specifies the term that will be used to obtain the value in your program, default([1.2, 0.4, 0.1, 2.5]) provides a default value if the argument is not used on the command line. longflags([numbers]) indicates that to look for a flag of the form --numbers. we could have also used shortflags([numbers]) instead if we would prefer to use -numbers. I don’t know of any strong arguments for either one but find, personally, that the long form is more intuitive.

The values passed on the command line are extracted using opt_arguments which will follow the specification you’ve provided. _AdditionalArguments refers to any arguments passed on the command line without dashes but here we do not have any. [numbers(N)] is a list of the parsed key(value) pairs from the command line. So for this example N is the list value we entered on the command line and it is then used as needed.

Part 2

You are given a positive integer $N. Write a script to find if it can be expressed as a ** b where a > 0 and b > 1. Print 1 if you succeed otherwise 0.

Solution


:- use_module(library(clpfd)).
:- use_module(library(optparse)).
/*
    You are given a positive integer $N.
    Write a script to find if it can be expressed
    as a ^ b where a > 0 and b > 1. 
    Print 1 if you succeed otherwise 0.
*/
opts_spec(
    [
        [opt(number), 
        default(0),
        longflags([number])]
    ]).

/*
    Ok, I'll admit, this is a pretty silly use of clpfd when
    a simple logarithm calculation would do the job! Still clpfd 
    is more fun.
*/    
ch_2(N) :-
    N0 is N -1,
    A in 0 .. N0,    
    B in 1 .. N0,
    N #= A ^ B,
    label([A,B]),
    writeln(1).
ch_2(_) :-
    writeln(0).
    
main:-
    opts_spec(OptsSpec),
    opt_arguments(OptsSpec, [number(N)], _AdditionalArguments),
    ch_2(N),
    halt.

Sample Run


$ swipl -s ch-2.p -g main --number=7
0
$ swipl -s ch-2.p -g main --number=8
1

Notes

For an extra bit of fun I decided to use library(clpfd) for this although it is most definitely a bit of over engineering! This can be done rather simply using logarithms. Here we see the same pattern as done in Part 1: define the specification, extract the values from the command line, and then use the values. Here the single argument is just a single value and so there is no need to wrap the value in quotes, however, if you add quotes anyway it will have no effect. For example:

$ swipl -s ch-2.p -g main --number="100"
1

Reference

optparse documentation

posted at: 17:11 by: Adam Russell | path: /prolog | permanent link to this entry