1% Simple illustration of positive-only learning within Aleph
    2% To run do the following:
    3%       a. Load Aleph
    4%       b. read_all(animals).
    5%       c. sat(1).
    6%       d. reduce.
    7%	or
    8%       a. Load Aleph
    9%       b. read_all(animals).
   10%       c. induce.

?- induce(Program). */

   16:-use_module(library(aleph)).   17:- if(current_predicate(use_rendering/1)).   18:- use_rendering(prolog).   19:- endif.   20:- aleph.   21:- set_random(seed(111)).   22:- aleph_set(evalfn,posonly).   23:- aleph_set(clauselength,2).   24:- aleph_set(gsamplesize,20).   25%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   26% class/2 learns the class (mammal/fish/reptile/bird) of various animals.
   27
   28%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   29% Mode declarations
   30
   31:- modeh(1,class(+animal,#class)).
   32:- modeb(1,has_gills(+animal)).   33:- modeb(1,has_covering(+animal,#covering)).
   34:- modeb(1,has_legs(+animal,#nat)).
   35:- modeb(1,homeothermic(+animal)).   36:- modeb(1,has_eggs(+animal)).   37:- modeb(1,not(has_gills(+animal))).   38:- modeb(1,nhas_gills(+animal)).   39:- modeb(*,habitat(+animal,#habitat)).
   40:- modeb(1,has_milk(+animal)).   41
   42:-determination(class/2,has_gills/1).   43:-determination(class/2,has_covering/2).   44:-determination(class/2,has_legs/2).   45:-determination(class/2,momeotermic/1).   46:-determination(class/2,has_egss/1).   47:-determination(class/2,nhas_gills/1).   48:-determination(class/2,habitat/2).   49:-determination(class/2,has_milk/1).   50
   51:-begin_bg.   52%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   53% Types
   54
   55animal(dog).  animal(dolphin).  animal(platypus).  animal(bat).
   56animal(trout).  animal(herring).  animal(shark). animal(eel).
   57animal(lizard).  animal(crocodile).  animal(t_rex).  animal(turtle).
   58animal(snake).  animal(eagle).  animal(ostrich).  animal(penguin).
   59animal(cat). animal(dragon).  animal(girl).  animal(boy).
   60
   61
   62class(mammal).  class(fish).  class(reptile).  class(bird).
   63
   64covering(hair).  covering(none).  covering(scales).  covering(feathers).
   65
   66habitat(land).  habitat(water).  habitat(air).  habitat(caves).
   67
   68%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   69
   70%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   71% Background knowledge
   72
   73has_covering(dog,hair).
   74has_covering(dolphin,none).
   75has_covering(platypus,hair).
   76has_covering(bat,hair).
   77has_covering(trout,scales).
   78has_covering(herring,scales).
   79has_covering(shark,none).
   80has_covering(eel,none).
   81has_covering(lizard,scales).
   82has_covering(crocodile,scales).
   83has_covering(t_rex,scales).
   84has_covering(snake,scales).
   85has_covering(turtle,scales).
   86has_covering(eagle,feathers).
   87has_covering(ostrich,feathers).
   88has_covering(penguin,feathers).
   89
   90has_legs(dog,4).
   91has_legs(dolphin,0).
   92has_legs(platypus,2).
   93has_legs(bat,2).
   94has_legs(trout,0).
   95has_legs(herring,0).
   96has_legs(shark,0).
   97has_legs(eel,0).
   98has_legs(lizard,4).
   99has_legs(crocodile,4).
  100has_legs(t_rex,4).
  101has_legs(snake,0).
  102has_legs(turtle,4).
  103has_legs(eagle,2).
  104has_legs(ostrich,2).
  105has_legs(penguin,2).
  106
  107has_milk(dog).
  108has_milk(cat).
  109has_milk(dolphin).
  110has_milk(bat).
  111has_milk(platypus).
  112
  113
  114homeothermic(dog).
  115homeothermic(cat).
  116homeothermic(dolphin).
  117homeothermic(platypus).
  118homeothermic(bat).
  119homeothermic(eagle).
  120homeothermic(ostrich).
  121homeothermic(penguin).
  122
  123
  124habitat(dog,land).
  125habitat(dolphin,water).
  126habitat(platypus,water).
  127habitat(bat,air).
  128habitat(bat,caves).
  129habitat(trout,water).
  130habitat(herring,water).
  131habitat(shark,water).
  132habitat(eel,water).
  133habitat(lizard,land).
  134habitat(crocodile,water).
  135habitat(crocodile,land).
  136habitat(t_rex,land).
  137habitat(snake,land).
  138habitat(turtle,water).
  139habitat(eagle,air).
  140habitat(eagle,land).
  141habitat(ostrich,land).
  142habitat(penguin,water).
  143
  144has_eggs(platypus).
  145has_eggs(trout).
  146has_eggs(herring).
  147has_eggs(shark).
  148has_eggs(eel).
  149has_eggs(lizard).
  150has_eggs(crocodile).
  151has_eggs(t_rex).
  152has_eggs(snake).
  153has_eggs(turtle).
  154has_eggs(eagle).
  155has_eggs(ostrich).
  156has_eggs(penguin).
  157
  158has_gills(trout).
  159has_gills(herring).
  160has_gills(shark).
  161has_gills(eel).
  162
  163nhas_gills(X) :- animal(X), not(has_gills(X)).
  164
  165aleph_false:-class(X,Y),class(X,Z),Y\=Z.
  166
  167:-end_bg.  168:-begin_in_pos.  169class(eagle,bird).
  170class(bat,mammal).
  171class(dog,mammal).
  172class(bat,mammal).
  173class(eagle,bird).
  174class(ostrich,bird).
  175class(shark,fish).
  176class(crocodile,reptile).
  177class(bat,mammal).
  178class(shark,fish).
  179class(penguin,bird).
  180class(shark,fish).
  181class(crocodile,reptile).
  182class(crocodile,reptile).
  183class(shark,fish).
  184class(dog,mammal).
  185class(snake,reptile).
  186class(platypus,mammal).
  187class(t_rex,reptile).
  188class(crocodile,reptile).
  189:-end_in_pos.  190
  191:-begin_in_neg.  192
  193:-end_in_neg.