Permalink
Browse files

init

  • Loading branch information...
0 parents commit 85288a2a1e83497cdbf612055422ae990f4324db Simon Kaltenbacher committed Jan 28, 2012
Showing with 1,319 additions and 0 deletions.
  1. +5 −0 README
  2. +136 −0 interface.pl
  3. +204 −0 lambda.pl
  4. +11 −0 rdf.pl
  5. +881 −0 recipes.pl
  6. +82 −0 util.pl
5 README
@@ -0,0 +1,5 @@
+%----------------------------------------------------------------------------
+% README
+%----------------------------------------------------------------------------
+
+This is a recipe collection in Prolog.
@@ -0,0 +1,136 @@
+:- module(interface, [printRecipe/2, listRecipes/0, optRep/2, listIngId/1]).
+
+:- use_module(library(lists)).
+:- use_module(library(apply)).
+:- use_module(lambda).
+:- use_module(rdf).
+:- use_module(recipes).
+:- use_module(util).
+
+% roundNot0(+Value, +N, ?RValue)
+roundNot0(0, _, 0) :- !.
+roundNot0(Value, N, RValue) :- round(Value, N, RValue), RValue > 0, !.
+roundNot0(Value, N1, RValue) :- N2 is N1 + 1, roundNot0(Value, N2, RValue).
+
+% Computes the optimal representation of a value with a unit.
+% optRep((+Value, +Unit), (?OptValue, ?OptUnit))
+optRep((Value, unit:Unit), (OptValue, unit:OptUnit)) :-
+ translation(unit:RefUnit, Factor1, unit:Unit),
+ findall((OptValue, OptUnit),
+ (translation(unit:RefUnit, Factor2, unit:OptUnit), OptValue is Value * Factor1 / Factor2, OptValue >= 1),
+ Reps),
+ sort(Reps, [(OptValue, OptUnit)|_]), !.
+optRep((Value, unit:Unit), (Value, unit:Unit)).
+
+prettify((Value, unit:Unit), (PValue, unit:PUnit)) :-
+ optRep((Value, unit:Unit), (OptValue, unit:PUnit)),
+ (p(unit:PUnit, precision, Precision) ->
+ roundNot0(OptValue, Precision, PValue)
+ ;
+ PValue = OptValue
+ ).
+
+% resolveName(+Quantity, +Id, ?Name)
+resolveName(Quantity, Id, Name) :-
+ Quantity =:= 1,
+ p(Id, singular, Name)
+ ;
+ Quantity =\= 1,
+ p(Id, plural, Name)
+ ;
+ p(Id, name, Name).
+
+% listIngId(+SearchTerm)
+listIngId(SearchTerm) :-
+ findall(
+ (ingredient:Id, Name),
+ (
+ member(Prop, [name, singular, plural]),
+ getId(SearchTerm, ingredient:Id, Prop, _, Name)
+ ),
+ IdNames
+ ),
+ (IdNames = [] ->
+ writeln('Die Suchanfrage lieferte keine Ergebnisse.')
+ ;
+ sort(IdNames, SIdNames),
+ group(SIdNames, IdGroups),
+ forall(
+ nth1(N, IdGroups, (Id, Names)),
+ (
+ write(N), write('. '),
+ atomic_list_concat(Names, ', ', Str),
+ writeln(Str),
+ write(' '), write(Id), nl
+ )
+ )
+ ).
+
+% printIng(+Statement, +Persons)
+% i
+printIng(i(ingredient:Ingredient), _) :-
+ p(ingredient:Ingredient, name, Name),
+ write(Name).
+% qi
+printIng(qi(Quantity1, ingredient:Ingredient), Factor) :-
+ Quantity2 is Quantity1 * Factor,
+ (
+ p(ingredient:Ingredient, precision, Precision), !
+ ;
+ Precision = 0
+ ),
+ roundNot0(Quantity2, Precision, RQuantity),
+ resolveName(RQuantity, ingredient:Ingredient, Name),
+ write(RQuantity), write(' '), write(Name).
+% qui
+printIng(qui(Quantity1, unit:Unit, ingredient:Ingredient), Factor) :-
+ Quantity2 is Quantity1 * Factor,
+ prettify((Quantity2, unit:Unit), (PQuantity, unit:PUnit)),
+ (
+ p(ingredient:Ingredient, name, IngredientName)
+ ;
+ p(ingredient:Ingredient, plural, IngredientName)
+ ),
+ resolveName(PQuantity, unit:PUnit, UnitName),
+ write(PQuantity), write(' '), write(UnitName), write(' '), write(IngredientName).
+
+% printPreparation
+printPreparation(recipe:Id) :-
+ p(recipe:Id, preparation, Text),
+ write(Text), nl.
+
+% printRecipe(+SearchTerm, ?Persons)
+printRecipe(SearchTerm, Persons) :-
+ setof((Start, L) - (Id, Name), (getId(SearchTerm, recipe:Id, name, Start, Name), atom_length(Name, L)), StartLengthIds),
+ (
+ StartLengthIds = [_ - (Id, _)], !
+ ;
+ StartLengthIds = [_|_],
+ keysort(StartLengthIds, SortedStartLengthIds),
+ nl, write('Folgende Rezepte wurden zu deiner Suchanfrage gefunden:'), nl, nl,
+ forall(nth1(Nth, SortedStartLengthIds, _ - (Id, Name)), (write(Nth), write('. '), write(Name), nl)), nl,
+ write('Auswahl: '), read(Sel),
+ nth1(Sel, SortedStartLengthIds, _ - (Id, _))
+ ),
+ printRecipe_aux(recipe:Id, Persons, 1).
+
+% printRecipe_aux
+printRecipe_aux(recipe:Id1, Persons, Factor1) :-
+ Persons > 0,
+ p(recipe:Id1, name, RecipeName),
+ nl, writeln('%--------------------------------------------------------------'),
+ write('% '), write(RecipeName), nl,
+ writeln('%--------------------------------------------------------------'), nl,
+ write('% Zutaten für '), write(Persons), (Persons > 1 -> write(' Personen'); write(' Person')), nl, nl,
+ printIngs(recipe:Id1, Persons, Factor1), nl,
+ writeln('% Zubereitung'), nl,
+ printPreparation(recipe:Id1),
+ forall(p(recipe:Id1, ref, (Factor2, recipe:Id2)), (Factor3 is Factor1 * Factor2, printRecipe_aux(recipe:Id2, Persons, Factor3))).
+
+% printIngs(+Id, ?Persons)
+printIngs(recipe:Id, Persons1, Factor) :-
+ p(recipe:Id, persons, Persons2),
+ forall(p(recipe:Id, ingredient, S), (printIng(S, Persons1 / Persons2 * Factor), nl)).
+
+% listRecipes
+listRecipes :- listEntities(recipe, '% Rezepte').
204 lambda.pl
@@ -0,0 +1,204 @@
+/*
+ Author: Ulrich Neumerkel
+ E-mail: ulrich@complang.tuwien.ac.at
+ Copyright (C): 2009 Ulrich Neumerkel. All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are
+met:
+
+1. Redistributions of source code must retain the above copyright
+ notice, this list of conditions and the following disclaimer.
+
+2. Redistributions in binary form must reproduce the above copyright
+ notice, this list of conditions and the following disclaimer in the
+ documentation and/or other materials provided with the distribution.
+
+THIS SOFTWARE IS PROVIDED BY Ulrich Neumerkel ``AS IS'' AND ANY
+EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL Ulrich Neumerkel OR
+CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+The views and conclusions contained in the software and documentation
+are those of the authors and should not be interpreted as representing
+official policies, either expressed or implied, of Ulrich Neumerkel.
+
+
+
+*/
+
+:- module(lambda, [
+ (^)/3, (^)/4, (^)/5, (^)/6, (^)/7, (^)/8, (^)/9,
+ (\)/1, (\)/2, (\)/3, (\)/4, (\)/5, (\)/6, (\)/7,
+ (+\)/2, (+\)/3, (+\)/4, (+\)/5, (+\)/6, (+\)/7,
+ op(201,xfx,+\)]).
+
+/** <module> Lambda expressions
+
+This library provides lambda expressions to simplify higher order
+programming based on call/N.
+
+Lambda expressions are represented by ordinary Prolog terms.
+There are two kinds of lambda expressions:
+
+ Free+\X1^X2^ ..^XN^Goal
+
+ \X1^X2^ ..^XN^Goal
+
+The second is a shorthand for t+\X1^X2^..^XN^Goal.
+
+Xi are the parameters.
+
+Goal is a goal or continuation. Syntax note: Operators within Goal
+require parentheses due to the low precedence of the ^ operator.
+
+Free contains variables that are valid outside the scope of the lambda
+expression. They are thus free variables within.
+
+All other variables of Goal are considered local variables. They must
+not appear outside the lambda expression. This restriction is
+currently not checked. Violations may lead to unexpected bindings.
+
+In the following example the parentheses around X>3 are necessary.
+
+==
+?- use_module(library(lambda)).
+?- use_module(library(apply)).
+
+?- maplist(\X^(X>3),[4,5,9]).
+true.
+==
+
+In the following X is a variable that is shared by both instances of
+the lambda expression. The second query illustrates the cooperation of
+continuations and lambdas. The lambda expression is in this case a
+continuation expecting a further argument.
+
+==
+?- Xs = [A,B], maplist(X+\Y^dif(X,Y), Xs).
+Xs = [A, B],
+dif(X, A),
+dif(X, B).
+
+?- Xs = [A,B], maplist(X+\dif(X), Xs).
+Xs = [A, B],
+dif(X, A),
+dif(X, B).
+==
+
+The following queries are all equivalent. To see this, use
+the fact f(x,y).
+==
+?- call(f,A1,A2).
+?- call(\X^f(X),A1,A2).
+?- call(\X^Y^f(X,Y), A1,A2).
+?- call(\X^(X+\Y^f(X,Y)), A1,A2).
+?- call(call(f, A1),A2).
+?- call(f(A1),A2).
+?- f(A1,A2).
+A1 = x,
+A2 = y.
+==
+
+Further discussions
+http://www.complang.tuwien.ac.at/ulrich/Prolog-inedit/ISO-Hiord
+
+@tbd Static expansion similar to apply_macros.
+@author Ulrich Neumerkel
+*/
+
+:- meta_predicate no_hat_call(0).
+
+:- meta_predicate
+ ^(?,0,?),
+ ^(?,1,?,?),
+ ^(?,2,?,?,?),
+ ^(?,3,?,?,?,?),
+ ^(?,4,?,?,?,?,?).
+
+^(V1,Goal,V1) :-
+ no_hat_call(Goal).
+^(V1,Goal,V1,V2) :-
+ call(Goal,V2).
+^(V1,Goal,V1,V2,V3) :-
+ call(Goal,V2,V3).
+^(V1,Goal,V1,V2,V3,V4) :-
+ call(Goal,V2,V3,V4).
+^(V1,Goal,V1,V2,V3,V4,V5) :-
+ call(Goal,V2,V3,V4,V5).
+^(V1,Goal,V1,V2,V3,V4,V5,V6) :-
+ call(Goal,V2,V3,V4,V5,V6).
+^(V1,Goal,V1,V2,V3,V4,V5,V6,V7) :-
+ call(Goal,V2,V3,V4,V5,V6,V7).
+
+:- meta_predicate
+ \(0),
+ \(1,?),
+ \(2,?,?),
+ \(3,?,?,?),
+ \(4,?,?,?,?),
+ \(5,?,?,?,?,?),
+ \(6,?,?,?,?,?,?).
+
+\(FC) :-
+ copy_term_nat(FC,C),no_hat_call(C).
+\(FC,V1) :-
+ copy_term_nat(FC,C),call(C,V1).
+\(FC,V1,V2) :-
+ copy_term_nat(FC,C),call(C,V1,V2).
+\(FC,V1,V2,V3) :-
+ copy_term_nat(FC,C),call(C,V1,V2,V3).
+\(FC,V1,V2,V3,V4) :-
+ copy_term_nat(FC,C),call(C,V1,V2,V3,V4).
+\(FC,V1,V2,V3,V4,V5) :-
+ copy_term_nat(FC,C),call(C,V1,V2,V3,V4,V5).
+\(FC,V1,V2,V3,V4,V5,V6) :-
+ copy_term_nat(FC,C),call(C,V1,V2,V3,V4,V5,V6).
+
+:- meta_predicate
+ +\(?,0),
+ +\(?,1,?),
+ +\(?,2,?,?),
+ +\(?,3,?,?,?),
+ +\(?,4,?,?,?,?),
+ +\(?,5,?,?,?,?,?),
+ +\(?,6,?,?,?,?,?,?).
+
++\(GV,FC) :-
+ copy_term_nat(GV+FC,GV+C),no_hat_call(C).
++\(GV,FC,V1) :-
+ copy_term_nat(GV+FC,GV+C),call(C,V1).
++\(GV,FC,V1,V2) :-
+ copy_term_nat(GV+FC,GV+C),call(C,V1,V2).
++\(GV,FC,V1,V2,V3) :-
+ copy_term_nat(GV+FC,GV+C),call(C,V1,V2,V3).
++\(GV,FC,V1,V2,V3,V4) :-
+ copy_term_nat(GV+FC,GV+C),call(C,V1,V2,V3,V4).
++\(GV,FC,V1,V2,V3,V4,V5) :-
+ copy_term_nat(GV+FC,GV+C),call(C,V1,V2,V3,V4,V5).
++\(GV,FC,V1,V2,V3,V4,V5,V6) :-
+ copy_term_nat(GV+FC,GV+C),call(C,V1,V2,V3,V4,V5,V6).
+
+
+%% no_hat_call(:Goal)
+%
+% Like call, but issues an error for a goal (^)/2. Such goals are
+% likely the result of an insufficient number of arguments.
+
+no_hat_call(MGoal) :-
+ strip_module(MGoal, _, Goal),
+ ( nonvar(Goal),
+ Goal = (_^_)
+ -> throw(error(existence_error(lambda_parameters,Goal),_))
+ ; call(MGoal)
+ ).
+
+% I would like to replace this by:
+% V1^Goal :- throw(error(existence_error(lambda_parameters,V1^Goal),_)).
11 rdf.pl
@@ -0,0 +1,11 @@
+:- module(rdf,[getId/5]).
+
+:- use_module(recipes).
+:- use_module(util).
+
+% getId(+SearchTerm, ?Id, ?Prop, ?Start, ?Name)
+getId(SearchTerm, Ns:Id, Prop, Start, Name) :-
+ p(Ns:Id, Prop, Name),
+ downcase_atom(SearchTerm, DSearchTerm),
+ downcase_atom(Name, DName),
+ once(sub_atom(DName, Start, _, _, DSearchTerm)).
Oops, something went wrong.

0 comments on commit 85288a2

Please sign in to comment.