Week 147: Pascal solutions

2 files changed, 123 insertions, 0 deletions

diff --git a/challenge-147/abigail/pascal/ch-1.p b/challenge-147/abigail/pascal/ch-1.p
new file mode 100644
index 0000000000..24dc514652
--- /dev/null
+++ b/challenge-147/abigail/pascal/ch-1.p
@@ -0,0 +1,82 @@
+Program XXX;
+
+(*                                                                   *)
+(* See https://theweeklychallenge.org/blog/perl-weekly-challenge-147 *)
+(*                                                                   *)
+
+(*                                           *)
+(* Run as: fpc -och-1.out ch-1.p; ./ch-1.out *)
+(*                                           *)
+
+var
+    todo: array of integer;
+    new_todo: array of integer;
+    pow, i, d: integer;
+    count: integer = 20;
+    candidate: integer;
+
+function is_prime (p: integer): boolean;
+    var
+        i: integer;
+
+    begin
+        if p = 2 then begin
+            is_prime := true;
+            exit;
+        end;
+        if p mod 2 = 0 then begin
+            is_prime := false;
+            exit;
+        end;
+        i := 3;
+        while i * i <= p do begin
+            if p mod i = 0 then begin
+                is_prime := false;
+                exit;
+            end;
+            i := i + 2;
+        end;
+        is_prime := true;
+        exit;
+    end;
+    
+
+begin
+    setlength (todo, 4);
+    todo [0] := 2;
+    todo [1] := 3;
+    todo [2] := 5;
+    todo [3] := 7;
+    for i := 0 to 3 do begin
+        write (todo [i], ' ');
+    end;
+    count := count - 4;
+    pow   := 10;
+    while count > 0 do begin
+        setlength (new_todo, 0);
+        for d := 1 to 9 do begin
+            for i := 0 to length (todo) - 1 do begin
+                candidate := d * pow + todo [i];
+                if is_prime (candidate) then begin
+                    insert (candidate, new_todo, length (new_todo));
+                    write (candidate, ' ');
+                    count := count - 1;
+                    if count <= 0 then begin
+                        break;
+                    end;
+                end;
+                if count <= 0 then begin
+                    break;
+                end;
+            end;
+            if count <= 0 then begin
+                break;
+            end;
+        end;
+        todo := new_todo;
+        pow  := pow * 10;
+    end;
+    writeln ('');
+end.
+
+end.
diff --git a/challenge-147/abigail/pascal/ch-2.p b/challenge-147/abigail/pascal/ch-2.p
new file mode 100644
index 0000000000..ac8d08d076
--- /dev/null
+++ b/challenge-147/abigail/pascal/ch-2.p
@@ -0,0 +1,41 @@
+Program ch2;
+
+(*                                                                   *)
+(* See https://theweeklychallenge.org/blog/perl-weekly-challenge-147 *)
+(*                                                                   *)
+
+(*                                           *)
+(* Run as: fpc -och-2.out ch-2.p; ./ch-2.out *)
+(*                                           *)
+
+uses
+    fgl;
+
+var
+    pentagon: specialize TFPGMap <longint, boolean>;
+    n, p, seen, i: longint;
+    done: boolean;
+
+begin
+    pentagon := specialize TFPGMap <longint, boolean> . Create;
+    p := 0;
+    n := 0;
+    done := false;
+    while not done do begin
+        p := p + n + n + n + 1;
+        n := n + 1;
+        pentagon . Add (p, true);
+        for i := 0 to pentagon . count - 1 do begin
+            seen := pentagon . Keys [i];
+            if (seen + seen <= p)                    and
+               (pentagon . IndexOf (p - seen) >= 0)  and
+               (pentagon . IndexOf (p - seen - seen) >= 0) then begin
+                writeln (seen, ' ', p - seen);
+                done := true;
+            end;
+            if done then begin
+                break;
+            end;
+        end
+    end
+end.