1% Simple illustration of using Aleph to do incremental learning
    2% To run do the following:
    3%       a. Load Aleph
    4%       b. read_all(mem).
    5%       c. induce_incremental.
    6% After that, just follow the menus on screen.

?- induce_incremental(Program). % try with this input mem(1,[1]). overgeneral. show(constraints). none. ok. ok. none. mem(1,[2,1]). because(overgeneral,not(mem(1,[2,3]))). none. ok. ok. none. none. */

   25% :- modeh(*,mem(+any,+list)).
   26% :- modeb(*,mem(+any,+list)).
   27% :- modeb(1,((+list) = ([-any|-list]))).
   28:- use_module(library(aleph)).   29:- aleph.   30:- if(current_predicate(use_rendering/1)).   31:- use_rendering(prolog).   32:- endif.   33
   34:- mode(*,mem(+any,+list)).   35:- mode(1,((+list) = ([-any|-list]))).   36
   37:- aleph_set(i,3).   38:- aleph_set(noise,0).   39:- aleph_set(print,1).   40
   41
   42:- determination(mem/2,mem/2).   43:- determination(mem/2,'='/2).