Prime triangle

Prime triangle is a draft programming task. It is not yet considered ready to be promoted as a complete task, for reasons that should be found in its talk page.

You will require a function f which when given an integer S will return a list of the arrangements of the integers 1 to S such that g₁=1 g_S=S and generally for n=1 to n=S-1 g_n+g_n+1 is prime. S=1 is undefined. For S=2 to S=20 print f(S) to form a triangle. Then again for S=2 to S=20 print the number of possible arrangements of 1 to S meeting these requirements.

F#

This task uses Extensible Prime Generator (F#) <lang fsharp> // Prime triangle. Nigel Galloway: April 12th., 2022 let fN i (g,(e,l))=e|>Seq.map(fun n->let n=i n in (n::g,List.partition(i>>(=)n) l)) let rec fG n g=function 0->n|>Seq.map fst |x->fG(n|>Seq.collect(fN(if g then fst else snd)))(not g)(x-1) let primeT row=fG [([1],([for g in {2..2..row-1} do if isPrime(g+1) then yield (1,g)],[for n in {3..2..row-1} do for g in {2..2..row-1} do if isPrime(n+g) then yield (n,g)]))] false (row-2)

                |>Seq.filter(List.head>>(+)row>>isPrime)|>Seq.map(fun n->row::n|>List.rev)

{2..20}|>Seq.iter(fun n->(primeT>>Seq.head>>List.iter(printf "%3d"))n;printfn "");; {2..20}|>Seq.iter(primeT>>Seq.length>>printf "%d "); printfn "" </lang>

Output:

  1  2
  1  2  3
  1  2  3  4
  1  4  3  2  5
  1  4  3  2  5  6
  1  4  3  2  5  6  7
  1  2  3  4  7  6  5  8
  1  2  3  4  7  6  5  8  9
  1  2  3  4  7  6  5  8  9 10
  1  2  3  4  7 10  9  8  5  6 11
  1  2  3  4  7 10  9  8  5  6 11 12
  1  2  3  4  7  6  5 12 11  8  9 10 13
  1  2  3  4  7  6 13 10  9  8 11 12  5 14
  1  2  3  4  7  6 13 10  9  8 11 12  5 14 15
  1  2  3  4  7  6  5 12 11  8 15 14  9 10 13 16
  1  2  3  4  7  6  5 12 11  8  9 10 13 16 15 14 17
  1  2  3  4  7  6  5  8  9 10 13 16 15 14 17 12 11 18
  1  2  3  4  7  6  5  8  9 10 13 16 15 14 17 12 11 18 19
  1  2  3  4  7  6  5  8  9 10 13 16 15 14 17 12 19 18 11 20

1 1 1 1 1 2 4 7 24 80 216 648 1304 3392 13808 59448 155464 480728 1588162

Julia

<lang julia>using Combinatorics, Random, Primes

function primetriangle(nrows::Integer)

   nrows < 2 && error("number of rows requested must be > 1")
   pmask, spinlock = primesmask(2 * (nrows + 1)), Threads.SpinLock()
   counts, rowstrings = [1; zeros(Int, nrows - 1)], ["" for _ in 1:nrows]
   for r in 2:nrows
       @Threads.threads for e in collect(permutations(2:2:r))
           p = zeros(Int, r - 1)
           for o in permutations(3:2:r)
               i = 0
               for (x, y) in zip(e, o)
                   p[i += 1] = x
                   p[i += 1] = y
               end
               length(e) > length(o) && (p[i += 1] = e[end])
               if pmask[p[i] + r + 1] && pmask[p[begin] + 1] && all(j -> pmask[p[j] + p[j + 1]], 1:r-2)
                   lock(spinlock)
                   if counts[r] == 0
                       rowstrings[r] = "  1" * prod([lpad(n, 3) for n in p]) * lpad(r + 1, 3) * "\n"
                   end
                   counts[r] += 1
                   unlock(spinlock)
               end
           end
       end
   end
   println("  1  2\n" * prod(rowstrings), "\n", counts)

end

@time primetriangle(16)

</lang>

Output:

  1  2  
  1  2  3
  1  2  3  4
  1  4  3  2  5
  1  4  3  2  5  6
  1  4  3  2  5  6  7
  1  2  3  4  7  6  5  8
  1  2  3  4  7  6  5  8  9
  1  2  3  4  7  6  5  8  9 10
  1  2  3  4  9 10  7  6  5  8 11
  1  2  3  4  9 10  7  6  5  8 11 12
  1  2  3  4  7  6  5 12 11  8  9 10 13
  1  2  3  4 13  6 11  8  9 10  7 12  5 14
  1  2  3  4 13  6 11  8  9 10  7 12  5 14 15
  1  2  3  4 13  6 11  8  9 10  7 12  5 14 15 16
  1  2 15  4 13  6 11  8  9 10  3 16  7 12  5 14 17

[1, 1, 1, 1, 1, 2, 4, 7, 24, 80, 216, 648, 1304, 3392, 13808, 59448]
  36.933227 seconds (699.10 M allocations: 55.557 GiB, 46.71% gc time, 0.37% compilation time)

Phix

Library: Phix/online

Not sure this counts as particularly clever but by the sound of things it's quite a bit faster than the other entries so far. 😎

with javascript_semantics
atom t0 = time()
sequence can_follow, avail, arrang
bool bCount = false

function ptrs(integer res, n, done)
    -- prime triangle recursive sub-procedure
    -- on entry, arrang[done] is set and arrang[$]==n.
    -- find something/everything that fits between them.
    -- if count is false just display the first and quit.
    integer ad = arrang[done]
    if n-done<=1 then
        if can_follow[ad][n] then
            if not bCount then
                printf(1,"%s\n",join(arrang,fmt:="%d"))
            end if
            res += 1
        end if
    else
        done += 1
        for i=2 to n-1 do
            if can_follow[ad][i] and avail[i] then
                arrang[done] = i
                avail[i] = false
                res = ptrs(res,n,done)
                if not bCount and res!=0 then return res end if
                avail[i] = true
            end if
        end for
    end if
    return res
end function

function prime_triangle(integer n)
    can_follow = repeat(repeat(false,n),n)
    for i=1 to n do
        for j=1 to n do
            if i!=j then
                can_follow[i][j] = is_prime(i+j)
            end if
        end for
    end for
    avail = reinstate(repeat(true,n),{1,n},{false,false})
    arrang = reinstate(repeat(0,n),{1,n},{1,n})
    integer res = ptrs(0,n,1)
    if bCount then progress("counting(%d) = %d\r",{n,res}) end if
    return res
end function

{} = apply(tagset(20,2),prime_triangle)
bCount = true
integer lim = iff(platform()=JS?18:20)
printf(1,"%s\n",join(apply(tagset(lim,2),prime_triangle),fmt:="%d"))
?elapsed(time()-t0)

Output:

1 2
1 2 3
1 2 3 4
1 4 3 2 5
1 4 3 2 5 6
1 4 3 2 5 6 7
1 2 3 4 7 6 5 8
1 2 3 4 7 6 5 8 9
1 2 3 4 7 6 5 8 9 10
1 2 3 4 7 10 9 8 5 6 11
1 2 3 4 7 10 9 8 5 6 11 12
1 2 3 4 7 6 5 12 11 8 9 10 13
1 2 3 4 7 6 13 10 9 8 11 12 5 14
1 2 3 4 7 6 13 10 9 8 11 12 5 14 15
1 2 3 4 7 6 5 12 11 8 15 14 9 10 13 16
1 2 3 4 7 6 5 12 11 8 9 10 13 16 15 14 17
1 2 3 4 7 6 5 8 9 10 13 16 15 14 17 12 11 18
1 2 3 4 7 6 5 8 9 10 13 16 15 14 17 12 11 18 19
1 2 3 4 7 6 5 8 9 10 13 16 15 14 17 12 19 18 11 20
1 1 1 1 1 2 4 7 24 80 216 648 1304 3392 13808 59448 155464 480728 1588162
"25.7s"

It is a fair bit slower under pwa/p2js, 18: 6s, 19: 20s, 20: 7 mins, hence the cap to 18, and you can run it in that state online here.

Raku

Limit the upper threshold a bit to avoid multiple hours of pointless calculations. Even just up to 17 takes over 20 minutes.

<lang perl6>my @count = 0, 0, 1; my $lock = Lock.new; put (1,2);

for 3..17 -> $n {

   my @even = (2..^$n).grep: * %% 2;
   my @odd  = (3..^$n).grep: so * % 2;
   @even.permutations.race.map: -> @e {
       quietly next if @e[0] == 8|14;
       my $nope = 0;
       for @odd.permutations -> @o {
           quietly next unless (@e[0] + @o[0]).is-prime;
           my @list;
           for (@list = (flat (roundrobin(@e, @o)), $n)).rotor(2 => -1) {
               $nope++ and last unless .sum.is-prime;
           }
           unless $nope {
               put '1 ', @list unless @count[$n];
               $lock.protect({ @count[$n]++ });
           }
           $nope = 0;
       }
   }

} put "\n", @count[2..*];</lang>

Output:

1 2
1 2 3
1 2 3 4
1 4 3 2 5
1 4 3 2 5 6
1 4 3 2 5 6 7
1 2 3 4 7 6 5 8
1 2 3 4 7 6 5 8 9
1 2 3 4 7 6 5 8 9 10
1 6 5 8 3 10 7 4 9 2 11
1 6 5 8 3 10 7 4 9 2 11 12
1 4 3 2 5 8 9 10 7 12 11 6 13
1 4 3 2 11 8 9 10 13 6 7 12 5 14
1 2 3 8 5 12 11 6 7 10 13 4 9 14 15
1 2 3 8 5 12 11 6 7 10 13 4 9 14 15 16
1 2 9 4 7 10 13 6 5 14 3 16 15 8 11 12 17

1 1 1 1 1 2 4 7 24 80 216 648 1304 3392 13808 59448

Wren

Library: Wren-perm

Library: Wren-fmt

As in the case of the Raku example, I've limited this to 17 which takes about 8.3 minutes on my machine though 18 should be doable. The number of permutations to plow through for the higher limits is enormous unless, of course, there is a 'clever' way of doing this. <lang ecmascript>import "./perm" for Perm import "./fmt" for Fmt

var limit = 17 var counts = List.filled(limit - 1, 0) var pmap = {} for (i in [2, 3, 5, 7, 11, 13, 17, 19, 23, 29, 31, 37]) {

   pmap[i] = true

}

var f = Fn.new { |i|

   var first = true
   if (i == 2) {
       System. print(" 1  2")
       counts[0] = 1
   } else if (i == 3) {
       System.print(" 1  2  3")
       counts[1] = 1
   } else {
       var evens = []
       var odds  = []
       for (j in 2..i-1) {
           if (j % 2 == 0) evens.add(j) else odds.add(j)
       }
       var fib1 = Fiber.new {
           Perm.generate(evens)
       }
       while (true) {
           var even = fib1.call()
           if (!even) break
           var fib2 = Fiber.new {
               Perm.generate(odds)
           }
           while (true) {
               var odd = fib2.call()
               if (!odd) break
               var s = List.filled(i, 1)
               s[-1] = i
               var j = 1
               for (e in even) {
                   s[j] = e
                   j = j + 2
               }
               j = 2
               for (o in odd) {
                   s[j] = o
                   j = j + 2
               }  
               var valid = true
               for (k in 0..i-2) {
                   if (!pmap[s[k] + s[k+1]]) {
                       valid = false
                       break
                   }
               }
               if (valid) {
                   counts[i-2] = counts[i-2] + 1
                   if (first) {
                       Fmt.print("$2d ", s)
                       first = false
                   }
               }
           }
       }
   }

}

for (i in 2..limit) f.call(i) System.print() System.print(counts.join(" "))</lang>

Output:

 1  2
 1  2  3
 1  2  3  4 
 1  4  3  2  5 
 1  4  3  2  5  6 
 1  4  3  2  5  6  7 
 1  2  3  4  7  6  5  8 
 1  2  3  4  7  6  5  8  9 
 1  2  3  4  7  6  5  8  9 10 
 1  2  3  4  7 10  9  8  5  6 11 
 1  2  3  4  7 10  9  8  5  6 11 12 
 1  2  3  4  7  6  5 12 11  8  9 10 13 
 1  2  3  4 13  6 11  8  9 10  7 12  5 14 
 1  2  3  4 13  6 11  8  9 10  7 12  5 14 15 
 1  2  3  4 13  6 11  8  9 10  7 12  5 14 15 16 
 1  2  3  4  7  6 11  8  9 10 13 16 15 14  5 12 17 

1 1 1 1 1 2 4 7 24 80 216 648 1304 3392 13808 59448