An introduction to Artificial Intelligence. Finlay and Dix. 1st Edition.

image.p

download

Header

%  =================================================================
%  ==                                                             ==
%  ==          An Introduction to ARTIFICIAL INTELLIGENCE         ==
%  ==                  Janet Finlay and Alan Dix                  ==
%  ==                       UCL Press, 1996                       ==
%  ==                                                             ==
%  =================================================================
%  ==                                                             ==
%  ==      chapter 8, image processing utilities                  ==
%  ==                 simple representation of a pixel image      ==
%  ==                                                             ==
%  ==          Prolog example, Alan Dix, September 1997           ==
%  ==                                                             ==
%  =================================================================

Code

%  uses element_at/3, length/2 from file 'list.p'
%  please:  consult('../util/list.p').

%  In the image processing examples, several representations are
%  used for pixel images.
%
%  This file gives the simplest representation.
%  The file 'gimage.p' describes the more complicated 'gimage'
%  representation which is used in the definition of various filters.

%  The file 'eximages.p' has the example images from figures in chapter 8.

%  The simplest and most important representation is a double list
%  (list of lists) of pixel values.
%  In particular, this is most useful for input/output.
%
%  For example the image in figure 8.2 (page 166) is represented as:
%
% image('figure 8.2', 15, 12,
%       [ [ 0,0,0,0,0,1,2,2,0,0,0,0,0,0,0 ],
%         [ 0,0,0,0,0,4,6,6,5,1,0,0,0,0,0 ],
%         [ 0,0,0,0,5,5,6,6,6,6,8,8,8,5,0 ],
%         [ 0,0,0,0,5,5,6,6,6,6,8,9,9,6,0 ],
%         [ 0,0,1,1,6,6,6,6,6,6,8,9,9,6,0 ],
%         [ 0,0,1,1,5,6,6,6,6,5,2,9,9,6,0 ],
%         [ 0,0,1,1,1,3,6,5,4,1,1,9,9,6,0 ],
%         [ 0,0,1,1,1,1,1,1,1,1,1,9,9,6,0 ],
%         [ 0,0,1,1,1,1,1,1,1,1,1,8,8,5,0 ],
%         [ 0,0,1,1,1,1,1,1,1,1,1,1,6,6,0 ],
%         [ 0,0,1,1,0,0,0,1,1,1,0,1,0,0,0 ],
%         [ 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 ]
%       ] ).
%
%  This definition can be found in the file 'eximages.p'

%  The predicates image_at/4 and raw_image_at/4 extract the pixel at
%  particular coordinates of an image.  The difference is that
%  raw_image_at is undefined outside the boundaries of the image
%  whereas image_at returns zero.

image_at( Image, X, Y, Pixel ) :-
            image_size(Image,Wid,Ht),
            image_at1( Image, Wid, Ht, X, Y, Pixel ).
image_at1( Image, Wid, Ht, X, Y, 0 ) :-
            nonvar(X), (X<1 ; X>Wid), !.    % out of bounds
image_at1( Image, Wid, Ht, X, Y, 0 ) :-
            nonvar(Y), (Y<1 ; Y>Ht), !.    % out of bounds
image_at1( Image, Wid, Ht, X, Y, Pixel ) :-
            raw_image_at( Image, X, Y, Pixel ).

raw_image_at( Image, X, Y, Pixel ) :-
            element_at(Image,Y,Scan_Y),
            element_at(Scan_Y,X,Pixel).

%  image_size/3 is used to calculate the width and height of an image
%  and also to create empty images of a given size.
%  The definition has to be carefully constructed to allow this
%  polymorphic use, hence it the first clause is not the more obvious
%  definiton of:
%            length( Image, Ht ),
%            element_at(Image, 1, First_Row),
%            length( First_Row, Wid ).
%  This would have only fixed the width of the first row of the image.
%  Note that because the definition below examines EVERY row, the predicate
%  only suceeds if the image is well formed and all the rows are of the
%  same length.

image_size( Image, Wid, Ht ) :-
            length( Image, Ht ),
            image_wid( Image, Wid ).

image_wid( [], Wid ).
image_wid( [Row|Image], Wid) :-
            length( Row, Wid ),
            image_wid( Image, Wid ).

image_wid2( Image, Row, Wid, Ht ) :-   % N.B. Row is always ground
            Row >= Ht, !.
image_wid2( Image, Row, Wid, Ht ) :-
            element_at(Image, Row, Scan_Row),
            length( Scan_Row, Wid ),
            Row1 is Row + 1,
            image_wid2( Image, Row1, Wid, Ht ).


Running this Code

%  RUNNING THIS CODE
%
%  Try some small examples first:
%
%>      image_size( [[0,1,0],[0,2,1]], Wid, Ht ).
%
%>      image_size( L, 5, 3 ).    % creates an empty 5 x 3 image
%
%>      image_at( [[1,2,3],[4,5,6],[7,8,9]], 2, 3, P ).
%
%>      raw_image_at( [[1,2,3],[4,5,6],[7,8,9]], 4, 2, P ).
%
%>      image_at( [[1,2,3],[4,5,6],[7,8,9]], 4, 2, P ).
%
%  Look at 'eximages.p' for larger examples.  Compare each one with
%  the corresponding example in the book.
%  Consult the file:
%        consult('eximages.p').
%
%  and then try retreiving images:
%>        image('figure 8.2', Wid, Ht, Image).
%
%  and finally use image_size and image_at on them
%>        image('figure 8.2', Wid, Ht, Image),
%+        image_size( Image, W, H ),      %  I hope the same as Wid and Ht!!
%+        image_at( Image, 11, 7, P ).

Examples

%  EXAMPLES
%
%>  image_size( [[0,1,0],[0,2,1]], Wid, Ht ).
%
%>  image_size( L, 5, 3 ).    % creates an empty 5 x 3 image
%
%>  image_at( [[1,2,3],[4,5,6],[7,8,9]], 2, 3, P ).
%
%>  raw_image_at( [[1,2,3],[4,5,6],[7,8,9]], 4, 2, P ).
%
%>  image_at( [[1,2,3],[4,5,6],[7,8,9]], 4, 2, P ).
%
%>  image('figure 8.2', Wid, Ht, Image).
%
%>  image('figure 8.2', Wid, Ht, Image),
%+  image_size( Image, W, H ),      %  I hope the same as Wid and Ht!!
%+  image_at( Image, 11, 7, P ).


Query

Response