How to correctly calculate the number of seating plans for the 4-couples problem?

With a little borrowing from JimB comment to populate all the possible solutions, another way to solve it is by using Partition[ ..., 2, 1, 1] to pick every two seat next to each other with start and ending seat case:

ps = Join[{-1}, #] & /@ Permutations[{1, -2, 2, -3, 3, -4, 4}];

result = DeleteCases[ps, l_ /; AnyTrue[Partition[l, 2, 1, 1], Plus @@ # == 0 &]]
(*Output Length: 1488 *)

If a couple sitting next to each other, then sum of them will be zero (one is $n$ other is $-n$), so we delete these cases.

For visualizing, you can use CirclePoints:

DrawTable[l_] := 
 Graphics[{Circle[], 
   MapIndexed[{White, EdgeForm[Black], Disk[#, .2], Black,Text[l[[#2[[1]]]], #1]} &, 
    CirclePoints[Length@l]]}]

DrawTable[{1, 2, 3}]

Out:

Visualize random samples:

DrawTable /@ RandomSample[result, 3]

DrawTable[# /. x_Integer :> Subscript[{"W", "H"}[[Sign@x]], Abs@x]] & /@ RandomSample[result, 3]

Sorry that this is a mess, but it takes a lot of time to make code pretty. Anyway, SatisfiabilityCount/SatisfiabilityInstances are the core of it all. This approach could be generalised to more complicated questions than round tables etc., but of course would need a different visualisation with those questions.

With[{couples = 4, (* Just for clarity: *) genders = 2},
 With[{seats = couples genders},
  And @@ Flatten@Join[
      (* Fix position of one person. *)
      {s[1, 1, 1]},
      (* Exactly one person per seat. *)
      Table[
       BooleanCountingFunction[{1}, couples genders] @@
        Flatten@Table[s[i, j, k], {j, couples}, {k, genders}], {i, 
        seats}],
      (* Exactly one instance of each person. *)
      Table[
       BooleanCountingFunction[{1}, seats] @@
        Table[s[i, j, k], {i, seats}], {j, couples}, {k, genders}],
      (* At most one person from a couple per adjacent seats. *)
      Table[
        BooleanCountingFunction[1, 2 genders] @@
         Flatten@Table[s[i, j, k], {i, {##}}, {k, genders}], {j, couples}] & @@@
       EdgeList@CycleGraph[seats]]
   // SatisfiabilityCount]]

1488

With[{couples = 4, (* Just for clarity: *) genders = 2},
 With[{seats = couples genders},
  With[{sols = And @@ Flatten@Join[
         (* Fix position of one person. *)
         {s[1, 1, 1]},
         (* Exactly one person per seat. *)
         Table[
          BooleanCountingFunction[{1}, couples genders] @@ 
           Flatten@Table[s[i, j, k],
             {j, couples}, {k, genders}], {i, seats}],
         (* Exactly one instance of each person. *)
         Table[
          BooleanCountingFunction[{1}, seats] @@ Table[s[i, j, k],
            {i, seats}], {j, couples}, {k, genders}],
         (* At most one person from a couple per adjacent seats. *)
         Table[
            BooleanCountingFunction[1, 2 genders] @@ 
             Flatten@Table[s[i, j, k],
               {i, {##}}, {k, genders}], {j, couples}] & @@@ 
          EdgeList@CycleGraph[seats]] //
      (* Pick variables (s[seat, couple, gender]) which are true. *)
      With[{vars = 
         Flatten@Table[
           s[i, j, k], {i, seats}, {j, couples}, {k, genders}]}, 
       Pick[vars, #] & /@ SatisfiabilityInstances[#, vars, All] &]},
   (* Draw a sample of graphs of seatings with couples. *)
   With[{samples = UpTo[20], perrow = UpTo[4]},
    (Graphics[
         {Circle[],
          Table[
           With[{pp = {Sin[#], Cos[#]} & /@ (# 2 [Pi]/seats)},
              {Black, Line@pp,
               LightRed, Disk[First@pp, 1/5],
               LightBlue, Disk[Last@pp, 1/5],
               Black, Text[i, #] & /@ pp}] &@
            SortBy[Last][Cases[#, s[s_, i, g_] :> {s, g}]][[All, 1]], {i, couples}]}] & /@
       RandomSample[sols, samples]) // 
     GraphicsGrid@Partition[#, perrow] &]]]]

By adding the following constraint to the problem we can find out that there are only 12 solutions where genders alternate around the table (odd seats must have a female, even seats a male):

(* Genders must alternate. *)
Table[Or @@ Table[s[i, j, Mod[i, 2, 1]], {j, couples}], {i, seats}],

couples = Graph[Array[h[#] <-> w[#] &, 4]]

seatingplans = FindCycle[GraphComplement[couples], {8}, All]

Length[seatingplans]
(* 744 *)

Graph[RandomChoice@seatingplans, 
 VertexLabels -> Placed[Automatic, Center], VertexSize -> 0.75]

Label the attendees as (1, -1, 2, -2, 3, -3, 4, -4) where (1,2,3 and 4) are type 1 and (-1,-2,-3,-4) are their respective partners and are of type 2. There are two necessary conditions (done here for n=4 couples):

1. Assuming the types are distinguishable then the only valid seating arrangements are all of the "type 1s" in seats (1,3,5,7) or in seats (2,4,6,8).

2. No two side-by-side seats sum to 0. The third argument in ListConvolve wraps the first and last seats next to each other.

   seatinglist = 
              Select[Permutations[Flatten[Table[{i, -i}, {i, 4}]]], 
               And [ Sort[#[[{1, 3, 5, 7}]]] == {1, 2, 3, 4} || 
                  Sort[#[[{2, 4, 6, 8}]]] == {1, 2, 3, 4}, 
                 Count[ ListConvolve[{1, 1}, #, -1], 0] == 0] &];
   Length[seatinglist]
    (* 96 *)