text:
Code Golf: 6174 - Kaprekar's mythical constant
Why is the number 6174 so interesting? As defined by Wikipedia

Take any four-digit number, using at
  least two different digits. (Leading
  zeros are allowed.)
Arrange the digits in ascending and
  then in descending order to get two
  four-digit numbers, adding leading
  zeros if necessary.
Subtract the smaller number from the
  bigger number.
Go back to step 2.

The above process, known as Kaprekar's
  routine, will always reach 6174 in at
  most 7 iterations. Once 6174 is
  reached, the process will continue
  yielding it.

Write a program which runs the Kaprekar's routine against a given four-digit number (see definition above) printing out each step of the routine.
Rules:

Submissions must be complete
programs.
Input must be read from standard
input. Piping from echo is OK.
Input should be in numeric form.
Printing out leading zeros is
required. (See examples below.)
Last line should say how many
iterations were needed. Punctuation is required.

Examples:
> 2607
7620 - 0267 = 7353
7533 - 3357 = 4176
7641 - 1467 = 6174
Iterations: 3.

> 1211
2111 - 1112 = 0999
9990 - 0999 = 8991
9981 - 1899 = 8082
8820 - 0288 = 8532
8532 - 2358 = 6174
Iterations: 5.

> 6174
7641 - 1467 = 6174
Iterations: 1.

Any programming language is welcome. Extra points for esoteric ones + a small bounty.
Update 1: There is already a similar question.
Update 2: Added example for 6174 as input. Thanks to Peter Taylor for the notice.

@lunohodov If you already have 6174 as input, do you really need one iteration to reach 6174? I only ask because I'll have to write a special case in my program if you do. :-(

@Gareth Yes, as the task is, as defined above, to run the Kaprekar's routine against a given four-digit number and 6174 should be treated as such.

This is the exact same question I had to do in the NCSS challenge. If you're doing this to get other people to give you the answer in the NCSS challenge, then that's pretty bad and it defeats the purpose of a challenge. If you're not, then I apolagize.

This question was posted in the middle of last year - I very much doubt anyone was trying to cheat for some test or challenge.

Perl - 147 143 134 130 129 126 129 128 126
for($_=<>;$_-6174+!$c;$c++){$_=reverse$d=join'',sort split//,"$_"
|$|x4;printf"$_ - $d = %04d\n",$_-=$d}die"Iterations: $c.\n"

EDIT: Now complies with 6174 case, at the cost of a few chars... run with echo -n <number> | perl kaprekar.pl
EDIT: Finally back to where I was before :D

Ruby 1.9, 122 characters
puts"Iterations: #{(1..7).find{s=$_.chars.sort*"";puts [r=s.reverse,?-,s,?=,$_="%04d"%(r.to_i-s.to_i)]*" ";~/6174/}}."

Example invocation:
$ echo 1211 | ruby -ln kaprekar.rb

I've counted the -ln flag as 4 characters (difference between the normal invocation ruby kaprekar.rb and ruby -ln kaprekar.rb).

I saved this script as kaprekar.rb then invoked it with ruby -lp kaprekar.rb. Entered a number and pressed  but the output is the entered number itself. Clearly I am missing something... Please advise how to use the script.

@lunohodov: I've added an example invocation. It now also generates the correct output for 6174 as input, which unfortunately brings this solution up to 128 characters.

Using echo 1234 | ruby kaprekar.rb raises a warning and ends with an error undefined method 'chars' for nil:NilClass (NoMethodError). Executing echo 1234 | ruby -lp kaprekar.rb issues only a warning and behaves as expected. The output is not as expected, as it contains a warning message kaprekar.rb:3: warning: regex literal in condition

@lunohodov: Fixed the warning and the example invocation.

Python, 141 chars
n=input()
i=0
while n-6174:a=''.join(sorted("%04d"%n));b=a[::-1];n=int(b)-int(a);print"%s - %s = %04d"%(b,a,n);i+=1
print"Iterations: %d."%i

+1 for slick padding with %04d. I learned something today!

A few suggestions: put the whole loop on one line using ;s. while n-6174.  No space between print and the quote.

@keith-randall: thanks, got it down to 141 now.

Golfscript, 74 characters
);:|;{0):0;|$:§-1%" - "§" = ""0"4$~§~-+-4>:|n|6174`=!}do"Iterations: "0"."

Haskell, 197 192 182 181 characters
import List
p=putStrLn.unwords
"6174"%k|k>0=p["Iterations:",shows k"."]
n%k=p[b,"-",a,"=",c]>>c%(k+1)where a=sort n;b=reverse a;c=take 4$shows(read b-read a)"0"
main=getLine>>=(%0)

Inlining r and s saves 2 characters. Also, "000" is redundant. "0" is enough. This brings us to 188 characters. I'm surprised interact does not help here. It usually does.

Replacing show x++s with shows x s gains 2 more bytes. 186 now.

By using pattern guards (|k>0) one can get rid of f. Further renaming g to % gets us to 182 chars.

><> - 268 308
</&4pff1
v>i86*-:n&1-:&?!
>ao&        v
<v&0pff+1gff
 >&1+:4=   ?v&:a%:}-a,
 v&8[4r::0}~<
 >&1-:?!v&:@@:@(?$}&:&3%1=?}
 v      >~:}}:}@:}$:}
 \:n}:n}:n}:n}' - 'ooo:n}:n}:n}:n}' = 'ooo
 \a*+a*+a*+}a*+a*+a*+-:0&\
 v?       =4&:+1&,a-}:%a:<
/\&~~rnnnnao:29777****=   ?v
voooooooooooo"Iterations: "/
\ffgna'.'oo;

Not much of a contender for golf, but it was fun to write. :)
Run with ./fish.py kaprekar.fish -v <number>
EDIT: Now takes input from STDIN.

JavaScript, 189 182 165 chars
Credit to DocMax:
for(n=prompt(i=o=e='');!i--|n-6174;o+=n+' - '+a+' = '+(n=(p=n-a+e)[3]?p:0+p)+'\n')
  b=n.split(e).sort(),n=b.reverse(a=b.join(e)).join(e);
alert(o+"Iterations: "+~i+'.')

Original:
for(n=prompt(i=o=e='');n-6174;o+=(i++?n+"\n":e)+(n=(a=n.split(e).sort().join(e)).split(e).reverse().join(e))+' - '+a+' = ',n=n-a+e)while(!n[3])n=0+n
alert(o+n+"\nIterations: "+i+'.')

Ungolfed:
var i = 0;
var n = prompt();
var out = '';
while (n != 6174) {
    while ((n=''+n).length<4) n='0'+n // pad number
    if(i)out+=n+"\n"

    a = n.split('').sort().join('');
    n = a.split('').reverse().join('');

    out += n + ' - ' + a + ' = '
    n-=a
    i++;
}
console.log(out + "6174\nIterations: " + i + '.');

I think that you can change n != 6174 to n-6174 since it will return zero, which is false (at least in C and Python).

The credit should go to keith-randall who suggested it for my Python solution.

You can save 5 more characters by replacing while(n.length<4) with while(!n[3]).

One more: replace o+"6174\n with o+n+"\n to save 2 more (down to 182).

I can't stop staring at this one! The following a) fixes the output when n=6174, b) rearranges when n+'\n' is added to avoid the conditional and an extra \n, c) uses a temp to avoid a join-split-join sequence, d) takes advantage of the fact that we only ever have to add a single '0' for padding: for(n=prompt(i=0,o=e='');n-6174;i++,o+=(n=(b=n.split(e).sort(),a=b.join(e),b).reverse().join(e))+' - '+a+' = '+(n=('0'+(n-a)).slice(-4))+'\n');alert(o+"Iterations: "+i+'.') which should be 172 chars.

Impressive! According to the spec above though, when n=6174, it has to go through at least one iteration, so I added a check if i is 0 (+4) but combined that with the i++. Unfortunately, that gives an off by one error, so I switched the increment to a decrement and then used a little bitwise trickery at the end (-1). Then I changed i=0,o=e='' to i=o=e='' (-2), reformatted the for loop to avoid extra parentheses (-1), expanded (b=...,a=...,b) bit (-2), and sneaked a=b.join inside the reverse() call (-1). So 169, not bad!

...Couple more! Replaced n=('0'+(n-a)).slice(-4) with n=(p=n-a+e)>999?p:0+p (-2) and replaced logical OR || with bitwise OR | (-1) = 166 chars.

I love sliding something into reverse(). I would never have through of it. I'm not seeing much more now, but there is replacing the new n=(p=n-a+e)>999?p:0+p with an old friend in n=(p=n-a+e)[3]?p:0+p (-1) = 165 chars.

PowerShell, 125 128 130 131
for($a,$OFS=$input+'';$b-6174;++$i){$a=$b=+($c=''+($x="$a 000"[0..4]|sort)[4..0])-"$x"
"$c-$x = {0:d4}"-f$a}"Iterations: $i."

Passes all test cases from the question.

Scala 276
object o{var i=0;def a(v:String){val c=v.toList.sortWith(_>_).mkString;val b=c.reverse;val d=c.toInt-b.toInt;val e="0"*(4-(d+"").length)+d;val p=c+" - "+b+" = "+e;if(d!=6174){println(p);i=i+1;a(e)}else{println(p+"\nIterations: "+(i+1)+".")}};def main(s:Array[String])=a(s(0))}

Scala 283
object o{var i=0;def a(v:String){val c=v.toList.sortWith(_>_).mkString;val b=c.reverse;val d=c.toInt-b.toInt;val e="0"*(4-(d+"").length)+d;val p=c+" - "+b+" = "+e;if(d!=6174){println(p);i=i+1;a(e)}else{println(p);println("Iterations: "+(i+1)+".")}};def main(s:Array[String])=a(s(0))}

diff:
else{println(p);println("Iterations: "+(i+1)+".")}};
// to
else{println(p+"\nIterations: "+(i+1)+".")}};

Clojure, 256 characters
(let[i #(Integer/parseInt%)f #(format"%04d"%)a #(->>% f sort(apply str)i)d #(->>% f sort reverse(apply str)i)k #(let[u(d %)l(a %)n(- u l)](println(f u)"-"(f l)"="(f n))n)](while true(println"Iterations:"(count(take-while #(not=% 6174)(iterate k(read)))))))

Scala 2.9, 194 characters
object K extends App{var(c,s)=(0,args(0));do{var d=s.sorted;var e=d.reverse.toInt-d.toInt;s="%04d".format(e);println(d.reverse+" - "+d+" = "+s);c+=1}while(s!="6174");print("Iterations: "+c+".")}

Makes use of the App trait from Scala 2.9.
Edit: gives correct output for initial input of 6174.

PHP, 215 259 276 characters
<?php echo">";$n=str_split(str_pad(trim(fgets(STDIN)),4,0,0));for($k=0,$z=0;$k-6174;$z++){sort($n);$a=implode($n);$b=strrev($a);$k=str_pad($b-$a,4,0,0);echo"$b - $a = $k\n";$n=str_split($k);}echo"Iterations: $z\n";

Ungolfed:
<?php
echo ">";
$n = str_split(str_pad(trim(fgets(STDIN)),4,0,0));
for($k=0, $z=0; $k-6174; $z++) {
    sort($n);
    $a = implode($n);
    $b = strrev($a);
    $k = str_pad($b-$a,4,0,0);
    echo "$b - $a = $k\n";
    $n = str_split($k);
}
echo "Iterations: $z\n";

I don't think you need the abs, max and min functions, since the sort will always mean that $b is greater than $a. That could save you 20ish characters. Also, I think that putting the sort inside the loop at the top will mean you only need to have it in your code once which will save you another 9.

Wow, I guess I got distracted by the "subtract the smaller number from the bigger number" instruction. Thanks.

<?function k($c){echo"> $c\n";$n=str_split(str_pad($c,4,0,0));for(;$k-6174;$z++){sort($n);$a=join($n);$b=strrev($a);$k=str_pad($b-$a,4,0,0);echo"$b - $a = $k\n";$n=str_split($k);}echo"Iterations: $z\n";}
You can save 12 characters by changing your for statement, calling this as a function and using join instead of implode.

Also, I hate mini-markdown.

CoffeeScript, 233 225 characters
o=e='';i=0;n=prompt()
while n!=6174
  n=e+n;q=(n='0'+n if !n[3]) for x in [0..2];n?=q;o+=n+"\n" if i;a=n.split(e).sort().join(e);n=a.split(e).reverse().join(e);o+=n+' - '+a+' = ';n-=a;i++
alert(o+"6174\nIterations: "+i+'.')

Try it here or with instructions here.

My browser freezes - had to cancel the execution of the script.

What number did you enter? I tried it in Firefox and Chrome for 4711 and 1 and a couple of others.

Using 0 (as suggested by the prompt) or clicking the cancel button causes Safari to freeze.

I don't know why it suggested that. You have to enter a number between 1 and 9998 whose digits are not all identical. 0 is the same as 0000 and will cause an infinite loop. It seems most of the solutions here skipped validating input to keep the number of characters down.

See http://i56.tinypic.com/bhhoqe.png Your output also ends with  "It took 5 iterations to reach Kaprekar's constant." which does not conform to the requirements.

True. New link in the answer to the actual JavaScript that the CoffeeScript above compiles to.

GAWK - 152 chars
This is a GNU awk version. It may not work with other non-gnu versions.
{for(z=$1;z-6174+!c;++k){split(z,a,"");asort(a);for(b=c=i=0;i<4;z=c-b){c+=a[i+1]*10^i;b=b*10+a[++i]}printf c" - %.4d = "z"\n",b}print"Iterations: "k"."}

$ awk -f k.awk <<< 9992
2999 - 9992 = 6993
3699 - 9963 = 6264
2466 - 6642 = 4176
1467 - 7641 = 6174
Iterations: 4

I receive awk: calling undefined function asort. Awk version is 20070501 running on OSX 10.6.7. Don't forget the . after the number of iterations.

lunohodov@: Added missing point. Also, I have used gnu awk (gawk), and that may explain the missing function.

The subtraction numbers are the wrong way round: e.g. should be 9992 - 2999 = 6993

JavaScript, 260 bytes
function z(c){for(u=c+y;u.length<4;)u=0+u;return u}for(p=prompt(i=0,r=y="");;)
if(s=(p+y).split(y).sort(),t=s.concat().reverse(),a=s.join(y),b=t.join(y),q=a<b?b:a,
w=a<b?a:b,p=z(q-w),i++,r+=z(q)+" - "+z(w)+" = "+p+"\n",p==6174)break;alert(r+
"Iterations: "+i+".")

Ruby, 179 chars but posting anyway
s=gets.chomp
n=0
begin
  s=s.to_s.chars.sort.reduce{|s,c|s+c}.rjust(4,'0')
  a=s.reverse
  puts"#{a} - #{s} = #{'%04d'%(s=a.to_i-s.to_i)}"
  n+=1
end while s!=6174
puts"Iterations: #{n}."

K, 104
{b::();{b,:,k," = ",r:"0"^(-:4)$$. k:(x@>x)," - ",x@<x;r}\[$x];-1'c,,"Iterations: ",$#c:$[1=#b;b;-1_b];}

Test cases
k){b::();{b,:,k," = ",r:"0"^(-:4)$$. k:(x@>x)," - ",x@<x;r}\[$x];-1'c,,"Iterations: ",$#c:$[1=#b;b;-1_b];}'2607 1211 6174;
7620 - 0267 = 7353
7533 - 3357 = 4176
7641 - 1467 = 6174
Iterations: 3
2111 - 1112 = 0999
9990 - 0999 = 8991
9981 - 1899 = 8082
8820 - 0288 = 8532
8532 - 2358 = 6174
Iterations: 5
7641 - 1467 = 6174
Iterations: 1

PERL
chomp($n=<STDIN>);
    do{
       $t++;
       $desc=join('',reverse sort split(//,$n));
       $asc=join('', sort split(//,$n));
       $n=($desc - $asc);
       for($i=4;$i>length $n;$i--){
          $n="0".$n;
       }
       print $desc." - ".$asc." = ".$n."\n";
       $n="6174" if $n eq "0000";
    }while($n ne "6174");
    print "Iterations: $t.\n";

Thats ~310 chars...

Mathematica, 314 291 characters
This is the program, kaprekar.m :-
SetOptions[$Output,FormatType->OutputForm];
x=$ScriptCommandLine[[2]];
f[x_]:=(a=Characters@x;
b=Sort@ToExpression@a;
c=Sort[FromDigits/@{#,Reverse@#}&@b];
{c,{b,a}}=IntegerString[{#2-#&@@c,c},10,4];
Print[a," - ",b," = ",c];c)
x=f@x;
e=NestWhileList[f,x,#!="6174"&];
Print["Iterations: ",N@Length@e]

Setting the path prior to running :-
$ PATH=${PATH}:/Applications/Mathematica.app/Contents/MacOS ; export PATH

Running the program :-
$ MathematicaScript -script kaprekar.m 2607
7620 - 0267 = 7353
7533 - 3357 = 4176
7641 - 1467 = 6174
Iterations: 3.
$ MathematicaScript -script kaprekar.m 1211
2111 - 1112 = 0999
9990 - 0999 = 8991
9981 - 1899 = 8082
8820 - 0288 = 8532
8532 - 2358 = 6174
Iterations: 5.
$ MathematicaScript -script kaprekar.m 6174
7641 - 1467 = 6174
Iterations: 1.

PHP, 160 bytes
function k($n,$d=1){$o=str_split($n);sort($o);echo$q=strrev($r=join($o))," - $r = ",$n=str_pad($q-$r,4,0,0),"
",$n==6174?"Iterations: $d.":k($n,++$d);}k($argn);

Try it online!
Complete program, input is STDIN, run with php -nF.
Output
> echo 2607|php -nF kap.php
7620 - 0267 = 7353
7533 - 3357 = 4176
7641 - 1467 = 6174
Iterations: 3.

> echo 1211|php -nF kap.php
2111 - 1112 = 0999
9990 - 0999 = 8991
9981 - 1899 = 8082
8820 - 0288 = 8532
8532 - 2358 = 6174
Iterations: 5.

> echo 6174|php -nF kap.php
7641 - 1467 = 6174
Iterations: 1.

Rust - 375 bytes
use std::io::{self,BufRead};fn main() {let mut x=io::stdin().lock().lines().next().unwrap().unwrap().parse::<i16>().unwrap();let mut n=0;println!("Iterations: {}.",loop {let mut v=[x/1000%10,x/100%10,x/10%10,x%10];v.sort();let j=v.iter().fold(0,|a,i|a*10+i);let k=v.iter().rev().fold(0,|a,i|a*10+i);x=k-j;n+=1;println!("{:04} - {:04} = {:04}",k,j,x);if x==6174{break n};});}

I present this as a possible "upper bound", I challenge anyone to find a language where a reasonable implementation of this is longer - as in there is nothing superfluous, but also nothing even remotely obvious that would shrink it significantly. The thing about Rust is that it takes about 120 characters just to read from stdin and parse into an integer. "Oh but then just use the string representation"... but im 99% confident that would be even longer

Perl 6 -n flag, 105 bytes
say "Iterations: "~+.&{{{say $!=.flip~" - $_"," = ",($/=$!.EVAL.fmt("%04d"));$/}([~] .comb.sort)}...6174}

Try it online!
I finally got to use my {}...* trick, since we need to have at least one iteration for 6174. I'm not sure why I need the extra wrapping .&{  } around the sequence though, which kinda sucks.
Explanation:
    .&{                         } # Call a function on the input
       {                }...6174  # Create a sequence that goes until 6174
        {           }([~] .comb.sort) # Get the sorted digits of the number
         say $!=.flip~" - $_"," = "~($/=$!.EVAL.fmt("%04d"))  # Print the iteration
                        ;$/  # Return the result
say "Iterations: "~+.&{      }     # Print the number of iterations


text:
Calculate the number of topologies on {1,2,...,n}
Task

Write a function/program which takes \$n\$ as a parameter/input and prints/returns the number of topologies (which is demonstrated below) on the set \$\{1,2,...,n\}\$.

Definition of Topology
Let \$X\$ be any finite set, and assume that \$T\$, which is subset of the power set of \$X\$ (i.e. a set containing subsets of \$X\$), satisfy these conditions:

\$X\$ and \$\emptyset\$ are in \$T\$.

If \$U, V\$ are in \$T\$, then the union of those two sets is in \$T\$.

If \$U, V\$ are in \$T\$, then the intersection of those two sets is in \$T\$.

...then \$T\$ is called the topology on \$X\$.
Specifications

Your program is either:

a function which takes \$n\$ as a parameter
or a program which inputs \$n\$

and prints or returns the number of (distinct) topologies on the set \$\{1,2,...,n\}\$.

\$n\$ is any non-negative integer which is less than \$11\$ (of course there's no problem if your program handles n bigger than \$11\$), and the output is a positive integer.

Your program should not use any kinds of library functions or native functions which  calculates the number of topology directly.

Example input (value of n) : 7
Example output/return : 9535241
You may check your return value at here or here.
Of course, shortest code wins.

The winner is decided, however, I may change the winner if shorter code appears..

Does it have to give results this century, or is a proof of correctness good enough?

@Peter In fact, I have no idea how long it'll take. Therefore proof of correctness of the program is good enough, but still the program should give a result in a reasonable time if n is small, like 4~5.

@JiminP, it seems that computing it for n=12 was worth a paper back in the day, and there isn't a known formula. For 4 or 5 I suspect it's doable in a few minutes by brute force.

Is the improper subset of 2^X also a topology?

@FUZxxl : Yes. I think that's called the discrete topology.

@Peter : Oops, I thought there was a formula, but that wasn't a 'complete' formula..

You can look here for the answer.

Haskell, 144 characters
import List
import Monad
p=filterM$const[True,False]
f n=sum[1|t<-p$p[1..n],let e=(`elem`t).sort,e[],e[1..n],all e$[union,intersect]`ap`t`ap`t]

Almost a direct implementation of the specification, modulo some monad magic.
Extremely slow for n > 4.

Python, 147 chars
N=input()
S=lambda i,K:1+sum(0if len(set(j&k for k in K)-K)-1 else S(j+1,K|set(j|k for k in K))for j in range(i,2**N))
print S(1,set([0,2**N-1]))

Quick for N<=6, slow for N=7, unlikely N>=8 will ever complete.
Individual sets are represented by integer bitmasks, and topologies by sets of bitmasks.  S(i,K) computes the number of distinct topologies you can form by starting with K and adding sets with bitmasks >= i.

Python, 131 chars
lambda n:sum(x&(x>>2**n-1)&all((~(x>>i&x>>j)|x>>(i|j)&x>>(i&j))&1 for i in range(2**n)for j in range(2**n))for x in range(2**2**n))

Expanded version:
def f(n):
    count = 0
    for x in range(2**2**n): # for every set x of subsets of [n] = {1,...,n}
        try:
            assert x & 1 # {} is in x
            assert (x >> 2 ** n - 1) & 1 # [n] is in x
            for i in range(2**n): # for every subset i of [n]...
                if x >> i & 1: # ...in x
                    for j in range(2**n): # for every subset j of [n]...
                        if x >> j & 1: # ...in x
                            assert (x >> (i | j)) & 1 # their union is in x
                            assert (x >> (i & j)) & 1 # their intersection is in x
            count += 1
        except AssertionError:
            pass
    return count

For example, suppose n = 3. The possible subsets of [n] are
0b000
0b001
0b010
0b011
0b100
0b101
0b110
0b111

where the ith bit indicates whether i is in the subset. To encode sets of subsets, we notice that each of these subsets either belongs or does not belong to the set in question. Thus, for example,
x = 0b10100001
0b000 # 1
0b001 # 0
0b010 # 1
0b011 # 0
0b100 # 0
0b101 # 0
0b110 # 0
0b111 # 1

indicates that x contains {}, {2}, and {1,2,3}.

Zsh, 83 characters
This solution matches the letter of your requirements (but not, of course, the spirit). There's undoubtedly a way to compress the numbers even more.
a=(0 3 S 9U 5CT 4HO6 5ODFS AMOZQ1 T27JJPQ 36K023FKI HW0NJPW01R);echo $[1+36#$a[$1]]

Jelly, 28 bytes
ŒP⁺f,œ|ɗþ`ẎẎṢe¥€Ʋ;ẠCaiʋẠʋ€RS

Try it online!
So, incredibly, slow. Times out on TIO for all \$n \ge 4\$, and running it locally with \$n = 4\$ still didn't produce an output after 15 minutes. That is because this answer has a time complexity of \$O(2^{2^n})\$, as we calculate \$\mathcal P(\mathcal P(\{1, 2, ..., n\}))\$ and filter on topologies.
How it works
ŒP⁺f,œ|ɗþ`ẎẎṢe¥€Ʋ;ẠCaiʋẠʋ€RS - Main link. Takes n on the left
ŒP                           - Powerset of X = [1, 2, ..., n]
  ⁺                          - Powerset of that
                        ʋ    - Last 4 links as a dyad f(T, X):
                Ʋ            -   Last 4 links as a monad g(T):
       ɗ                     -     Last 3 links as a dyad h(U, V):
   f                         -       U ∩ V
     œ|                      -       U ∪ V
    ,                        -       [U ∩ V, U ∪ V]
        þ`                   -     For all U ∈ T, V ∈ T, calculate h(U, V)
          ẎẎ                 -     Flatten into a list of unions and intersections
              ¥              -     Last 2 links as a dyad k(Z, T):
            Ṣ                -       Sort Z
             e               -       Is Z ∈ T?
               €             -     For each Z in the list of unions and intersections, find k(Z, T)
                      ʋ      -   Last 4 links as a dyad l(T, X):
                  Ạ          -     Are all elements of T truthy?
                   C         -     Complement; are any falsey?
                     i       -     Index of X in T, or 0 if not present
                    a        -     And; are both true?
                 ;           -   Concatenate the list of k(Z, T)s with l(T, X)
                       Ạ     -   Are all true?
                          R  - X = [1, 2, ..., n]
                         €   - Over each T ∈ P(P(X)), calculate f(T, X)
                           S - Count the truthy elements

Scala, 450 343 bytes
Thanks to the comment, saved 107 bytes using some trivial tricks.

rewrite @user76284's solution into scala.
Using scala for calculation is so slow! On TIO, I only use one case f(4)=355

Golfed version. Try it online!
def f(n:Int)={var c=0;for(x<-0 until math.pow(2,math.pow(2,n)).toInt){try{assert((x&1)!=0);assert((x>>((math.pow(2,n)-1).toInt)&1)!=0);for(i<-0 until math.pow(2,n).toInt){if(((x>>i)&1)!=0){for(j<-0 until math.pow(2,n).toInt){if(((x>>j)&1)!=0){assert(((x>>(i|j))&1)!=0);assert(((x>>(i&j))&1)!= 0);}}}}; c+=1;}catch{case _:AssertionError=>;}};c}

Ungoled version. Try it online!
object Main {
  def f(n: Int): Int = {
    var count = 0
    for (x <- 0 until math.pow(2, math.pow(2, n)).toInt) {
      try {
        assert((x & 1) != 0)
        assert((x >> ((math.pow(2, n) - 1).toInt) & 1) != 0)
        for (i <- 0 until math.pow(2, n).toInt) {
          if ( ((x >> i) & 1) != 0) {
            for (j <- 0 until math.pow(2, n).toInt) {
              if ( ((x >> j) & 1) != 0) {
                assert( ((x >> (i | j)) & 1) != 0)
                assert( ((x >> (i & j)) & 1) != 0)
              }
            }
          }
        }
        count += 1
      } catch {
        case _: AssertionError =>
      }
    }
    count
  }

  def main(args: Array[String]): Unit = {
    val n =4
    val result = f(n)
    println(s"f($n) = $result")
  }
}

Can you remove a lot of the spaces, and use single character variables names (e.g. c instead of count) to save a bunch of bytes?

source: Stack Exchange

license: Creative Commons - Attribution Share-Alike - https://creativecommons.org/licenses/by-sa/4.0/

all_licenses: Creative Commons - Attribution Share-Alike - https://creativecommons.org/licenses/by-sa/3.0/

sort: votes