1%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 2/* Nan.Numerics.Prime 3 A simple prime number library 4 Copyright 2016 Julio P. Di Egidio 5 <mailto:julio@diegidio.name> 6 <http://julio.diegidio.name/Projects/Nan.Numerics.Prime/> 7 8 This file is part of Nan.Numerics.Prime. 9 10 Nan.Numerics.Prime is free software: you can redistribute it and/or modify 11 it under the terms of the GNU General Public License as published by 12 the Free Software Foundation, either version 3 of the License, or 13 (at your option) any later version. 14 15 Nan.Numerics.Prime is distributed in the hope that it will be useful, 16 but WITHOUT ANY WARRANTY; without even the implied warranty of 17 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 18 GNU General Public License for more details. 19 20 You should have received a copy of the GNU General Public License 21 along with Nan.Numerics.Prime. If not, see <http://www.gnu.org/licenses/>. 22*/ 23%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 24 25% (SWI-Prolog 7.3.25) 26 27% TODO: Use gobal variables? 28% TODO: Implement size limits? (By recent use?) 29 30:- module(prime_mem, []). 31 32:- public 33 gen_/2, % ?P1:prime, ?P2:prime 34 get_/1, % ?P:prime 35 get_/2, % ?P1:prime, ?P2:prime 36 add_/2, % +P1:prime, +P2:prime 37 count_/1, % -Count:nonneg 38 max_/1, % -Max:prime 39 clear_/0. %
56:- initialization(clear_). 57 58%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
64gen_(P1, P2) :-
65 table_(P1, P2).
2
) successor/predecessor prime.74get_(2) :- !. 75get_(P) :- 76 table_get_(P, _), !. 77get_(P) :- 78 table_get_(_, P). 79 80get_(P1, P2) :- 81 table_get_(P1, P2).
NOTE: Does not check that P1, P2 is a pair of consecutive prime numbers and that the pair has not already been memoized.
90add_(P1, P2) :-
91 table_add_(P1, P2),
92 flag_set_(count, C, C + 1),
93 flag_set_(max, P, max(P, P2)).
99count_(Count) :-
100 flag_get_(count, Count).
Max is 2
if no memoized pair exists.
108max_(Max) :-
109 flag_get_(max, Max).
115clear_ :- 116 clearall_, 117 flag_set_(count, 0), 118 flag_set_(max, 2). 119 120%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 121 122% table_(?T1:nonneg, ?T2:nonneg) is nondet. 123 124:- dynamic 125 table_/2. 126 127% table_get_(?T1:nonneg, ?T2:nonneg) is semidet. 128 129table_get_(T1, T2) :- 130 table_(T1, T2), !. 131 132% table_add_(+T1:nonneg, +T2:nonneg) is det. 133 134table_add_(T1, T2) :- 135 assertz(table_(T1, T2)). 136 137% flags_(?Key:atom, ?Val:nonneg) is nondet. 138 139:- dynamic 140 flags_/2. 141 142% flag_get_(+Key:atom, -Val:nonneg) is det. 143 144flag_get_(Key, Val) :- 145 (flags_(Key, Val); Val = 0), !. 146 147% flag_set_(+Key:atom, +New:arith(nonneg)) is det. 148 149flag_set_(Key, New) :- 150 flag_set_(Key, _, New). 151 152% flag_set_(+Key:atom, -Old:nonneg, +New:arith(nonneg)) is det. 153 154flag_set_(Key, Old, New) :- 155 flag_get_(Key, Old), Val is New, 156 ignore(( 157 Val \== Old, 158 ignore(retract(flags_(Key, _))), 159 assertz(flags_(Key, Val)) 160 )). 161 162% clearall_ is det. 163 164clearall_ :- 165 retractall(table_(_, _)), 166 retractall(flags_(_, _)). 167 168%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
A simple prime number library :: memoization
Module
prime_mem
provides low-level predicates for the memoization of pairs of consecutive prime numbers.NOTE: Predicates in this module are not meant for public use.