Initial data commit

Task/Paraffins/Pascal/paraffins-1.pas

@@ -0,0 +1,88 @@
+Program Paraffins;
+
+uses
+  gmp;
+
+const
+  max_n = 500;
+  branch = 4;
+
+var
+  rooted, unrooted: array [0 .. max_n-1] of mpz_t;
+  c: array [0 .. branch-1] of mpz_t;
+  cnt, tmp: mpz_t;
+  n: integer;
+  fmt: pchar;
+  sum: integer;
+
+procedure tree(br, n, l: integer; sum: integer; cnt: mpz_t);
+  var
+    b, m: integer;
+  begin
+    for b := br + 1 to branch do
+    begin
+      sum := sum + n;
+      if sum >= max_n then
+	exit;
+
+      (* prevent unneeded long math *)
+      if (l * 2 >= sum) and (b >= branch) then
+	exit;
+
+      if b = (br + 1) then
+	mpz_mul(c[br], rooted[n], cnt)
+      else
+      begin
+	mpz_add_ui(tmp, rooted[n], b - br - 1);
+	mpz_mul(c[br], c[br], tmp);
+	mpz_divexact_ui(c[br], c[br], b - br);
+      end;
+
+      if l * 2 < sum then
+	mpz_add(unrooted[sum], unrooted[sum], c[br]);
+
+      if b < branch then
+      begin
+	mpz_add(rooted[sum], rooted[sum], c[br]);
+	for m := n-1 downto 1 do
+	  tree(b, m, l, sum, c[br]);
+      end;
+    end;
+  end;
+
+procedure bicenter(s: integer);
+begin
+  if odd(s) then
+    exit;
+  mpz_add_ui(tmp, rooted[s div 2], 1);
+  mpz_mul(tmp, rooted[s div 2], tmp);
+  mpz_tdiv_q_2exp(tmp, tmp, 1);
+
+  mpz_add(unrooted[s], unrooted[s], tmp);
+end;
+
+begin
+  for n := 0 to 1 do
+  begin
+    mpz_init_set_ui(rooted[n], 1);
+    mpz_init_set_ui(unrooted[n], 1);
+  end;
+  for n := 2 to max_n-1 do
+  begin
+    mpz_init_set_ui(rooted[n], 0);
+    mpz_init_set_ui(unrooted[n], 0);
+  end;
+  for n := 0 to BRANCH-1 do
+    mpz_init(c[n]);
+
+  mpz_init(tmp);
+
+  mpz_init_set_ui(cnt, 1);
+  sum := 1;
+  for n := 1 to MAX_N do
+  begin
+    tree(0, n, n, sum, cnt);
+    bicenter(n);
+    mp_printf('%d: %Zd'+chr(13)+chr(10), n, @unrooted[n]);
+  end;
+end.

Task/Paraffins/Pascal/paraffins-2.pas

@@ -0,0 +1,110 @@
+program CountAlkanes;
+
+{$mode objfpc}{$H+}
+
+uses SysUtils; // only for output
+
+type TArrayUint64 = array of uint64;
+{
+  Function to count alkanes, based on: Shinsaku Fujita,
+  "Numbers of Alkanes and Monosubstituted Alkanes.
+  A Long-Standing Interdisciplinary Problem over 130 Years",
+  Bull. Chem. Soc. Jpn. Vol. 83, No. 1, 1–18 (2010)
+}
+function CountAlkanes() : TArrayUint64;
+const
+  MAX_RESULT_INDEX = 49; // as far as this code can get without multi-precision
+  MAX_R_INDEX = MAX_RESULT_INDEX div 2;
+var
+  R : array [0..MAX_R_INDEX] of uint64;
+  nrCentUnb : uint64; // number of centroidal unbalanced alkanes
+  temp : uint64;
+  m, n, h, i, j, k : integer;
+begin
+  SetLength( result, MAX_RESULT_INDEX + 1); // zero-based
+{
+  Calculate enough of the coefficients R[], where the generating function
+     r(x) = R[0] + R[1]x + R[2]x^2 + R[3]x^3 + ...  satifies
+     r(x) = 1 + (x/6)[r(x)^3 + 2r(x^3) + 3r(x)r(x^2)]  (Fujita, equation 4)
+}
+  R[0] := 1;
+  n := 0;
+  repeat
+    if (n mod 3 = 0) then temp := 2*R[n div 3]
+                     else temp := 0;
+    for j := 0 to (n div 2) do begin
+      inc( temp, 3 * R[j] * R[n - 2*j]);
+    end;
+    for j := 0 to n do begin
+      for k := 0 to (n - j) do begin
+        inc(temp, R[j] * R[k] * R[n - j - k]);
+      end;
+    end;
+    Assert( temp mod 6 = 0);  // keep an eye on it
+    inc(n);
+    R[n] := temp div 6;
+  until (n = MAX_R_INDEX);
+{
+  Now use the generating function
+    (x/24)[r(x)^4 + 3r(x^2)^2 + *r(x)r(x^3) + 6r(x)^2r(x^2) + 6r(x^4)]
+  where inserting r(x) up to the term in x^m will give the number of alkanes
+  of orders 2m+1 and 2m+2, as the coefficients of x^(2m+1) and x^(2m+2).
+
+  Note: In Fujita's paper, equation 23, the factor is 1/24 not x/24,
+        but x/24 seems to be needed to give correct results.
+}
+  result[0] := 1;  // conventional
+  for n := 1 to MAX_RESULT_INDEX do begin
+    m := (n - 1) div 2; // so n = 2*m + 1 or 2*m + 2
+    temp := 0;
+
+    // These loops are written for clarity not efficiency
+    for k := 0 to m do begin
+      for j := 0 to m do begin
+        for i := 0 to m do begin
+          h := n - 1 - i - j - k;
+          if  (h >= 0) and (h <= m) then inc( temp, R[h]*R[i]*R[j]*R[k]);
+        end;
+      end;
+    end;
+
+    if Odd(n) then begin
+      for k := 0 to m do begin
+        inc( temp, 3*R[k]*R[m - k]);
+      end;
+    end;
+
+    for k := 0 to (n - 1) div 3 do begin
+      j := n - 1 - 3*k;
+      if (j <= m) then inc( temp, 8*R[j]*R[k]);
+    end;
+
+    for k := 0 to m do begin
+      for j := 0 to m do begin
+        i := n - 1 - 2*k - j;
+        if (i >= 0) and (i <= m) then inc( temp, 6*R[i]*R[j]*R[k]);
+      end;
+    end;
+
+    if (n mod 4 = 1) then inc( temp, 6*R[(n - 1) div 4]);
+
+    Assert( temp mod 24 = 0);  // keep an eye on it
+    nrCentUnb := temp div 24;
+    if Odd(n) then
+      result[n] := nrCentUnb
+    else begin
+      temp := R[n div 2];
+      result[n] := nrCentUnb + (temp*(temp + 1) div 2);
+    end;
+  end;
+end;
+
+// Call function and display the results
+var
+  nrAlkanes : TArrayUint64;
+  k : integer;
+begin
+  nrAlkanes := CountAlkanes();
+  for k := 0 to Length( nrAlkanes) - 1 do
+    WriteLn( SysUtils.Format( '%2d %d', [k, nrAlkanes[k]]));
+end.