| Bytes | Lang | Time | Link |
|---|---|---|---|
| 259 | JavaScript ES10 | 230405T110939Z | Arnauld |
| 199 | R | 230418T210912Z | Kirill L |
| nan | Wolfram LanguageMathematica | 230418T003807Z | 138 Aspe |
| 1374 | Python3 | 230406T150427Z | Ajax1234 |
| 073 | 05AB1E | 230405T134207Z | Kevin Cr |
JavaScript (ES10), 259 bytes
For now, this is just a slightly modified version of my answer to this other challenge so that reflections are discarded. Supports \$n=0\$.
f=(n,m=[...o=Array(w=n)],i=c=0)=>n?m.map((r,y)=>m.map((_,x,[...m])=>!i|1<<x&~r&(m[y+1]|r/2|r*2)&&f(n-1,m,m[y]|=1<<x)))|c:[...3/64+''].some(k=>o[M=(k^6||m.reverse(),m=m.map(a=(_,y)=>m.map(b=(v,x)=>a|=b|=(v>>y&1)<<w+~x)|b)).flatMap(v=>v/(a&-a)||[])])?0:o[M]=++c
R, 205 199 bytes
f=\(n,o={},v=0,u=0,`~`=c,`?`=sort,d=-1~1i~1~-1i){for(j in u)F=F+`if`(length(p<-?j~o)<n,f(n,p,v,setdiff((u=u[-1])~j+d,v<-j~v)),2^(-all(apply(Conj(p)%o%d,2,a<-\(x)any(diff(p-?x))))-a(-p)-a(p*1i))/n);F}
A variation of my answer to the related challenge adapted to account for reflections.
Specifically, since the polyominoes \$p\$ are stored as complex numbers, reflections across both axes and diagonals can be represented by their complex conjugates \$Conj(p)\$ multiplied by directional vectors in \$d\$.
Wolfram Language(Mathematica), 532 496 366 bytes
saved so many bytes thanks to the comment of @Aiden Chow
Modified from the Mathematica code provided by A000105. Really naive. I don't know what I'm doing.
z[p_]:=Union[(#-(Min@Re@p+Min@Im@p*I))&/@p];Q[1]={{0}};Q[n_]:=Module[{f,g,a={}},g=((f=#;({f,#+1,f,#+I,f,#-1,f,#-I}&/@f))&)/@Q[n-1];f=Select[Union[z/@Partition[Flatten@g,n]],Length@#==n&];While[f!={},a={a,Z=f[[1]]};f=Complement[f,Union[z/@Flatten[{#,(#-2Re@#)&/@#}&/@Module[{i=Z,a={Z}},While[(i=I*i)!=Z,a~AppendTo~i];a],1]]]];Partition[Flatten@a,n]];F[n_]:=Length@Q@n
The original Mathematica code looks like
(* In this program by Jaime Rangel-Mondragón, polyominoes are represented as a list of Gaussian integers. *)
polyominoQ[p_List] := And @@ ((IntegerQ[Re[#]] && IntegerQ[Im[#]])& /@ p);
rot[p_?polyominoQ] := I*p;
ref[p_?polyominoQ] := (# - 2 Re[#])& /@ p;
cyclic[p_] := Module[{i = p, ans = {p}}, While[(i = rot[i]) != p, AppendTo[ans, i]]; ans];
dihedral[p_?polyominoQ] := Flatten[{#, ref[#]}& /@ cyclic[p], 1];
canonical[p_?polyominoQ] := Union[(# - (Min[Re[p]] + Min[Im[p]]*I))& /@ p];
allPieces[p_] := Union[canonical /@ dihedral[p]];
polyominoes[1] = {{0}};
polyominoes[n_] := polyominoes[n] = Module[{f, fig, ans = {}}, fig = ((f = #1; ({f, #1 + 1, f, #1 + I, f, #1 - 1, f, #1 - I}&) /@ f)&) /@ polyominoes[n - 1]; fig = Partition[Flatten[fig], n]; f = Select[Union[canonical /@ fig], Length[#1] == n &]; While[f != {}, ans = {ans, First[f]}; f = Complement[f, allPieces[First[f]]]]; Partition[Flatten[ans], n]];
a[n_] := a[n] = Length[ polyominoes[n]];
Table[Print["a(", n, ") = ", a[n]]; a[n], {n, 1, 12}] (* Jean-François Alcover, Mar 24 2015, after Jaime Rangel-Mondragón *)
Python3, 1374 bytes*:
R=range
E=enumerate
def U(b):
q,s=[b],[b]
while q:
b=q.pop(0)
if(T:=[i[::-1]for i in b])not in s:q+=T,;s+=T,
if(T:=[*map(list,zip(*[i[::-1]for i in zip(*b)]))])not in s:q+=T,;s+=T,
if(T:=[*map(list,zip(*b))])not in s:q+=T,;s+=T,
return s
Z=lambda B:[[j[0]if j else j for j in i]for i in B]
def S(b):
b=[[*i]for i in b if any(i)]
if 1-any([*zip(*b)][0]):b=[i[1:]for i in b]
if 1-any([*zip(*b)][-1]):b=[i[:-1]for i in b]
return b
C=lambda b:[(x,y)for x,t in E(b)for y,j in E(t)if j]
P=[(1,0),(0,1),(-1,0),(0,-1)]
def M(b):
t=C(b)
q=[t.pop(0)]
while q:
x,y=q.pop()
for j,k in P:
c=(x+j,y+k)
if c in t:t.remove(c);q+=c,
return[]==t
V=lambda b,x,y:x*y==0 or len(b)==x or len(b[0])==y
def f(n):
w=int(n**0.5)
b=[[[1,0]for _ in R(w)]for _ in R(n//(w or 1))]+[[[1,0]for _ in R(n%(w or 1))]]*(n%(w or 1)>0)
B=[i+[0]*(max(map(len,b))-len(i))for i in b]
q,s=[B],[Z(B)]
while q:
b=q.pop(0);c=C(b)
for x,y in c:
if 0==b[x][y][1]:
for X,Y in c:
if(X,Y)!=(x,y):
for j,k in P:
J,K=X-j,Y-k;B=eval(str(b));B[x][y]=0
if(J,K)not in c:
if K==len(B[0]):B=[i+[0]for i in B]
if K<0:B=[[0]+i for i in B];K=0
if J==len(B):B=B+[[0 for _ in B[0]]]
if J<0:B=[[0 for _ in B[0]]]+B;J=0
B[J][K]=[1,1]
if M(S(Z(B)))and all(S(Q)not in s for Q in U(S(Z(B)))):q+=B,;s+=S(Z(B)),
return len(s)
* Rather long in bytes, but computes solutions up to and including \$n = 9\$ in under 40 seconds on TIO.
05AB1E, 73 bytes
Should have been 1 byte less by replacing })}€ê with }){}, but the many nested maps/loops cause a bug in 05AB1E here (})ê} and })}€{ also doesn't work strangely enough..)
1ÝInãʒOQiyƶIô©Δ2Fø0δ.ø}2Fø€ü3}®Ā*εεÅsyøÅsM}}}˜Ùg<]εIô2Føʒà}}4FDíDø})}€êÙg
Basically the exact same approach as my answer for the related challenge, but with a single added Duplicate (in step 4) to also remove reflections in addition to the rotations.
Extremely slow brute-force, so is only able to output up to \$a(4)\$ on TIO.
Try it online or verify the first few results.
Explanation:
Also mostly a copy-paste from my answer of the related challenge, except for step 4.
Step 1: Create all possible \$n^2\$-sized lists using 0s and 1s, consisting of \$n\$ amount of 1s:
1Ý # Push pair [0,1]
In # Push the squared input
ã # Cartesian power
ʒ # Filter this list of lists by:
i # If
O # the sum of the current list
Q # is equal to the (implicit) input-integer:
# Continue with the check in step 2 below
# (implicit else: implicitly use the implicit input for the filter;
# this is only truthy for edge case n=1, which fails step 2 due to the `ü3`)
Try just this first step online (without trailing i).
Step 2: Filter it further to only keep single polynominos, using a flood-fill approach:
y # Push the current list again
ƶ # Multiply each value by its 1-based index
Iô # Convert the list to an input-by-input block
© # Store this block in variable `®` (without popping)
Δ # Loop until the result no longer changes to flood-fill the matrix:
2Fø0δ.ø} # Add a border of 0s around the matrix:
2F } # Loop 2 times:
ø # Zip/transpose; swapping rows/columns
δ # Map over each row:
0 .ø # Add a leading/trailing 0
2Fø€ü3} # Convert it into overlapping 3x3 blocks:
2F } # Loop 2 times again:
ø # Zip/transpose; swapping rows/columns
€ # Map over each inner list:
ü3 # Convert it to a list of overlapping triplets
®Ā # Push matrix `®` and convert all its positive values back to 1s
* # Multiply each 3x3 block by this matrix of 0s/1s (so 0s will remain 0s)
εεÅsyøÅsM # Get the largest value from the horizontal/vertical cross of each 3x3 block:
εε # Nested map over each 3x3 block:
Ås # Pop and push its middle row
y # Push the 3x3 block again
ø # Zip/transpose; swapping rows/columns
Ås # Pop and push its middle rows as well (the middle column)
M # Push the flattened maximum of the entire (scoped) stack,
# which is the flattened maximum of the cross of the current 3x3 block
}} # Close the nested map
}˜ # After the flood-fill loop: flatten the block to a list
Ù # Uniquify its values
g # Pop and push its length
< # Decrease it by 1 to account for the 0s
# (only 1 is truthy in 05AB1E, so only single islands remain)
] # Close both the if-statement and filter
Try just the first two steps online.
Step 3: Convert all valid lists to matrices, and slash off any rows/columns of 0s to have the actual polynominos:
ε # Map over each inner list
Iô # Convert it to an n-by-n block
2F # Inner loop 2 times:
ø # Zip/transpose; swapping rows/columns
ʒ # Filter this list of rows by:
à # Get the maximum of the row (so if it only contains 0s, it'll be removed)
} # Close the filter
} # Close the inner loop
Try just the first three steps online.
Step 4: Remove all duplicated rotations and reflections, by first converting each polynomino to a quartet of its four sorted rotations, then get the reflection of each rotation, and then uniquify that list of octets.
4F # Inner loop 4 times:
D # Duplicate the current polynomino-matrix
í # Reverse each inner row to reflect it
D # Duplicate this new reflected polynomino-matrix again
ø # Zip/transpose the matrix; swapping rows/columns
}) # After the loop: wrap the eight rotations + reflections on the stack into a list
# Explanation if the 05AB1E bug mentioned at the top wasn't present:
{ # Sort the octet of rotations + reflections
}Ù # After the map: uniquify the list of polynomino-rotations/reflections
# Actual explanation with bug:
}€ # After the map: open a new map:
ê # Sort and uniquify each octet
Ù # After the map: uniquify the list of distinct polynomino-orientations/reflections
Try just the first four steps online.
Step 5: Get the amount of unique polynominos left, and output it as result:
g # Pop and push the length
# (which is output implicitly as result)