YAPC::EU 2018 Glasgow Update!

Task/Aliquot-sequence-classifications/00DESCRIPTION

@@ -12,7 +12,7 @@ being K and subsequent members being the sum of the [[Proper divisors]] of the p
 :* K that have a sequence that eventually forms a periodic repetition of period >= 2 but of a number other than K, for example 562 which forms the sequence <code>562, 284, 220, 284, 220, ...</code> such K are called '''cyclic'''.
 
 :<br>And finally:
-:* Some K form aliquot sequences that are not known to be either terminating or periodic. these K are to be called '''non-terminating'''. <br>For the purposes of this task, K is to be classed as non-terminating if it has not been otherwise classed after generating '''16''' terms or if any term of the sequence is greater than 2**47 = 140,737,488,355,328.
+:* Some K form aliquot sequences that are not known to be either terminating or periodic; these K are to be called '''non-terminating'''. <br>For the purposes of this task, K is to be classed as non-terminating if it has not been otherwise classed after generating '''16''' terms or if any term of the sequence is greater than 2**47 = 140,737,488,355,328.
 
 
 ;Task:

Task/Aliquot-sequence-classifications/C/aliquot-sequence-classifications-1.c

@@ -1,5 +1,3 @@
-/*Abhishek Ghosh, 1st November 2017*/
-
 #include<stdlib.h>
 #include<string.h>
 #include<stdio.h>

Task/Aliquot-sequence-classifications/C/aliquot-sequence-classifications-2.c

@@ -1,5 +1,3 @@
-/*Abhishek Ghosh, 7th November 2017*/
-
 #include<string.h>
 #include<stdlib.h>
 #include<stdio.h>

Task/Aliquot-sequence-classifications/Factor/aliquot-sequence-classifications.factor

@@ -0,0 +1,54 @@
+USING: combinators combinators.short-circuit formatting kernel
+literals locals math math.functions math.primes.factors
+math.ranges namespaces pair-rocket sequences sets ;
+FROM: namespaces => set ;
+IN: rosetta-code.aliquot
+
+SYMBOL: terms
+CONSTANT: 2^47 $[ 2 47 ^ ]
+CONSTANT: test-cases {
+    11 12 28 496 220 1184 12496 1264460 790
+    909 562 1064 1488 15355717786080
+}
+
+: next-term ( n -- m ) dup divisors sum swap - ;
+
+: continue-aliquot? ( hs term -- hs term ? )
+    {
+        [ terms get 15 < ]
+        [ swap in? not   ]
+        [ nip zero? not  ]
+        [ nip 2^47 <     ]
+    } 2&& ;
+
+: next-aliquot ( hs term -- hs next-term term )
+    [ swap [ adjoin    ] keep ]
+    [ dup  [ next-term ] dip  ] bi terms inc ;
+
+: aliquot ( k -- seq )
+    0 terms set HS{ } clone swap
+    [ continue-aliquot? ] [ next-aliquot ] produce
+    [ drop ] 2dip swap suffix ;
+
+: non-terminating? ( seq -- ? )
+    { [ length 15 > ] [ [ 2^47 > ] any? ] } 1|| ;
+
+:: classify ( seq -- classification-str )
+    {
+        [ seq non-terminating? ] => [ "non-terminating" ]
+        [ seq last zero?       ] => [ "terminating"     ]
+        [ seq length 2 =       ] => [ "perfect"         ]
+        [ seq length 3 =       ] => [ "amicable"        ]
+        [ seq first seq last = ] => [ "sociable"        ]
+        [ seq 2 tail* first2 = ] => [ "aspiring"        ]
+        [ "cyclic" ]
+    } cond ;
+
+: .classify ( k -- )
+    dup aliquot [ classify ] keep "%14u: %15s: %[%d, %]\n"
+    printf ;
+
+: main ( -- )
+    10 [1,b] test-cases append [ .classify ] each ;
+
+MAIN: main

Task/Aliquot-sequence-classifications/Ring/aliquot-sequence-classifications.ring

@@ -1,7 +1,4 @@
 # Project : Aliquot sequence classnifications
-# Date    : 2017/11/16
-# Author : Gal Zsolt (~ CalmoSoft ~)
-# Email   : <calmosoft@gmail.com>
 
 see "Rosetta Code - aliquot sequence classnifications" + nl
 while true

Task/Aliquot-sequence-classifications/VBA/aliquot-sequence-classifications.vba

@@ -0,0 +1,66 @@
+Option Explicit
+
+Private Type Aliquot
+   Sequence() As Double
+   Classification As String
+End Type
+
+Sub Main()
+Dim result As Aliquot, i As Long, j As Double, temp As String
+'display the classification and sequences of the numbers one to ten inclusive
+   For j = 1 To 10
+      result = Aliq(j)
+      temp = vbNullString
+      For i = 0 To UBound(result.Sequence)
+         temp = temp & result.Sequence(i) & ", "
+      Next i
+      Debug.Print "Aliquot seq of " & j & " : " & result.Classification & "   " & Left(temp, Len(temp) - 2)
+   Next j
+'show the classification and sequences of the following integers, in order:
+Dim a
+   '15 355 717 786 080 : impossible in VBA ==> out of memory
+   a = Array(11, 12, 28, 496, 220, 1184, 12496, 1264460, 790, 909, 562, 1064, 1488)
+   For j = LBound(a) To UBound(a)
+      result = Aliq(CDbl(a(j)))
+      temp = vbNullString
+      For i = 0 To UBound(result.Sequence)
+         temp = temp & result.Sequence(i) & ", "
+      Next i
+      Debug.Print "Aliquot seq of " & a(j) & " : " & result.Classification & "   " & Left(temp, Len(temp) - 2)
+   Next
+End Sub
+
+Private Function Aliq(Nb As Double) As Aliquot
+Dim s() As Double, i As Long, temp, j As Long, cpt As Long
+   temp = Array("non-terminating", "Terminate", "Perfect", "Amicable", "Sociable", "Aspiring", "Cyclic")
+   ReDim s(0)
+   s(0) = Nb
+   For i = 1 To 15
+      cpt = cpt + 1
+      ReDim Preserve s(cpt)
+      s(i) = SumPDiv(s(i - 1))
+      If s(i) > 140737488355328# Then Exit For
+      If s(i) = 0 Then j = 1
+      If s(1) = s(0) Then j = 2
+      If s(i) = s(0) And i > 1 And i <> 2 Then j = 4
+      If s(i) = s(i - 1) And i > 1 Then j = 5
+      If i >= 2 Then
+         If s(2) = s(0) Then j = 3
+         If s(i) = s(i - 2) And i <> 2 Then j = 6
+      End If
+      If j > 0 Then Exit For
+   Next
+   Aliq.Classification = temp(j)
+   Aliq.Sequence = s
+End Function
+
+Private Function SumPDiv(n As Double) As Double
+'returns the sum of the Proper divisors of n
+Dim j As Long, t As Long
+    If n > 1 Then
+        For j = 1 To n \ 2
+            If n Mod j = 0 Then t = t + j
+        Next
+    End If
+    SumPDiv = t
+End Function