text:
Are these dice nontransitive?
Nontransitive dice are nice little toys that defy our intuition in probability theory. We'll need a few definitions for this challenge:
Consider two dice A and B which are thrown at the same time. We say that A beats B if the probability of A showing a larger number than B is strictly greater than the probability of B showing a larger number than A.
Now consider a set of three dice, with labels A, B, C. Such a set of dice is called nontransitive if

either A beats B, B beats C and C beats A
or C beats B, B beats A and A beats C.

As one of my favourite examples, consider the Grime dice, which have the following sides:
A: 3 3 3 3 3 6
B: 2 2 2 5 5 5
C: 1 4 4 4 4 4

Interestingly, the mean of each die is 3.5, just like a regular die.
One can show that:

A beats B with a probability of 7/12.
B beats C with a probability of 7/12.
C beats A with a probability of 25/36.

Now these particular dice are even weirder. If we roll each die twice and add up the results, the order of which beats which gets reversed:

B beats A with a probability of 85/144.
C beats B with a probability of 85/144.
A beats C with a probability of 671/1296.

Let's call a set of dice with this property Grime-nontransitive.
On the other hand, if the dice retain their original cycle when using two throws, we call them strongly nontransitive. (If there is no cycle at all for two throws, we simply call them nontransitive.)
The Challenge
Given three six-sided dice, determine which of the above properties this set has, and output one of the following strings: none, nontransitive, Grime-nontransitive, strongly nontransitive.
You may write a program or function, take input via STDIN, command-line argument, prompt or function argument, and write the result to STDOUT or return it as a string.
You may assume that all sides are non-negative integers. You cannot assume that the sides or the dice are in any particular order. You can take input in any convenient list or string format.
This is code golf, so the shortest answer (in bytes) wins.
Test Cases
none
1 2 3 4 5 6, 6 5 4 3 2 1, 1 3 5 2 4 6
1 1 1 6 6 6, 4 4 4 5 5 5, 5 5 5 5 5 5
1 1 2 5 6 6, 2 2 3 4 4 6, 2 3 3 4 4 5
0 1 2 3 4 5, 1 1 2 3 3 5, 1 2 2 2 3 5
3 13 5 7 13 7, 5 7 11 5 7 13, 5 9 13 5 7 9

nontransitive
1 2 2 4 6 6, 1 2 3 5 5 5, 2 3 4 4 4 4
1 4 4 4 4 4, 2 2 2 4 5 6, 2 3 3 3 5 5
1 2 1 6 5 6, 3 1 3 6 2 6, 2 4 2 4 4 5
3 4 6 6 7 7, 4 4 4 7 7 7, 5 5 5 5 6 7
2 5 11 11 14 14, 5 5 5 14 14 14, 8 8 8 8 8 17

Grime-nontransitive
3 3 3 3 3 6, 2 2 2 5 5 5, 1 4 4 4 4 4
1 1 4 5 5 5, 2 2 2 3 6 6, 3 3 3 4 4 4
2 1 4 6 4 4, 2 4 5 2 3 5, 3 3 6 3 3 3
11 11 13 15 15 16, 12 12 12 13 16 16, 13 13 13 14 14 14
4 4 7 16 19 19, 4 7 13 13 13 19, 4 10 10 10 16 19

strongly nontransitive
2 2 2 5 5 5, 2 3 3 3 5 5, 1 1 4 5 5 5
2 2 2 3 6 6, 2 2 2 5 5 5, 2 2 4 4 4 5
1 5 1 3 6 5, 6 6 4 2 2 1, 5 3 4 3 4 2
0 0 2 4 4 5, 0 1 1 3 5 5, 1 1 2 3 4 4
1 1 9 17 17 21, 1 5 5 13 21 21, 5 5 13 13 13 17

If you want to test your code even more thoroughly, Peter Taylor was kind enough to write a reference implementation, which classified all ~5000 sets of dice with sides 1 to 6 and a mean of 3.5. Pastebin link

I had totally forgotten about non-transitive dice. Thank you  :)

Is the first nontransitive example correct? 1 2 2 4 6 6, 1 2 3 5 5 5, 2 3 4 4 4 4 I'm getting A<B 17/36, B>C 19/36, C<A 16/36.

@Tobia You're forgetting that draws are possible. You also need to work out how often each dice loses against the others, and check if that's less than the winning probability: Yes A wins against B with 17/36, but A loses against B with only 16/36, so A beats B. Likewise, C wins against A with 16/36 as you said, but C loses against A with only 14/36, so C beats A.

Dyalog APL, 107 100 bytes
{({+/×+/¨,¨×⍵∘.-¨1⌽⍵}{3≠|a←⍺⍺⍵:1⋄a=b←⍺⍺∘.+⍨¨⍵:2⋄3+a=-b}⍵)⊃(⊂'none'),'strongly '⍬'Grime-',¨⊂'nontransitive'}
{T←{+/×+/¨∊¨×⍵∘.-¨1⌽⍵}⋄3≠|S←T⍵:'none'⋄N←'nontransitive'⋄S=D←T∘.+⍨¨⍵:'strongly ',N⋄S=-D:'Grime-',N⋄N}
(Thanks @Tobia for this simpler, shorter, better solution)
Basics:

← assignment

⋄ statement separator

{} lambda form

⍺⍵ left and right argument

A:B guard ("if A then return B")

T is a function that returns 3 if A beats B, B beats C, and C beats A; -3 if the exact opposite is the case; and something inbetween otherwise.  In detail:

1⌽⍵ is the one-rotation of ⍵.  If ⍵ is ABC, the rotation is BCA.

∘.- computes a subtraction table between two vectors (1 2...10 ∘.× 1 2...10 would be the multiplication table we know from school).  We apply this between each (¨) item of ⍵ and its corresponding item in 1⌽⍵.

× signum of all numbers in the subtraction tables

∊¨ flatten each table

+/¨ and sum it.  We now have three numbers that represent balances: number of winning minus losing cases for each of A vs B, B vs C, C vs A.

× signum of those

+/ sum

Then handle the cases in turn:

3≠|S←T⍵:'none' if T⍵'s absolute value isn't 3, return 'none'

N←'nontransitive' we'll need this word a lot

S=D←T∘.+⍨¨⍵:'strongly ',N compute T for pairs of dice (∘.+⍨¨⍵ ←→ ⍵((∘.+)¨)⍵) and return "strongly..." if the same relationships among ABC still hold

S=-D:'Grime-',N ⍝ "Grime" if the relationships are in the opposite directions

N if all else fails, just "nontransitive"

You beat me to it! I was working on this problem 3 days ago, but then I stopped just short of writing my answer. It's too similar to yours anyways, so I'll just post it here. It's a bit shorter at 100 chars: {T←{+/×+/¨∊¨×⍵∘.-¨1⌽⍵}⋄3≠|S←T⍵:'none'⋄N←'nontransitive'⋄S=D←T∘.+⍨¨⍵:'strongly ',N⋄S=-D:'Grime-',N⋄N}

@MartinBüttner: The correct term in the title is "characters", because the amount of bytes will vary depending on the charset used to encode the APL symbols. Traditionally they were just encoded in the upper half of 8-bit bytes, after ASCII. Nowadays we use UTF-8, but the old charsets are still useful… mainly to reduce the byte count to the character count when golfing!

@Tobia In code golf shorter trumps earlier, so you win!  I'm not really familiar with golfing etiquette but I think you should post it as a separate answer as it's substantially different and you arrived at it independently.

@Tobia I prefer to count in characters, too, but if classic encoding is implied, then bytes=characters, so maybe it doesn't really matter much what we call them...

@Tobia Well it's definitely useless to supply the character count in a challenge that scores by bytes. However, no one ever said we're scoring in UTF-8 bytes. In fact the tag wiki explicitly says that a different existing encoding can be used for characters outside the ASCII range. And APL does have its own codepage so the entire character set does fit within a byte. The policy on PPCG is to use this codepage to count APL - it's hardly fair to punish APL for being older than ASCII.

@MartinBüttner ok great. NGN, you can update your answer with my version if you wish. It's golfing etiquette to suggest improvements, instead of posting another answer, when it's the same language, same algorithm, and just some golfing tricks.

Python 2, 269
Here's a nice little expression that evaluates to a function. It accepts three lists of integers. Passes all test cases.
lambda A,B,C,w=lambda A,B:cmp(sum(cmp(a,b)for a in A for b in B),0),x=lambda A,B:cmp(sum(cmp(a+c,b+d)for a in A for b in B for c in A for d in B),0): (w(A,B)==w(B,C)==w(C,A)!=0)*((x(A,B)==x(B,C)==x(C,A))*["","strongly ","Grime-"][x(A,B)*w(A,B)]+"nontransitive")or"none"

J - 311 257 bytes
Update (13 Jan 2015):
g=:4 :'(+/,x>/y)>+/,y>/x'
h=:4 :'(,+/~x)g,+/~y'
f=: 3 :0
'a b c'=:y
if. (b g a)*(c g b)*a g c do.
a=.2{y
c=.0{y
end.
'none'([`]@.((a g b)*(b g c)*c g a))((''([`]@.((b h a)*(c h b)*a h c))'Grime-')([`]@.((a h b)*(b h c)*c h a))'strongly '),'nontransitive'
)

Explanation: Using Gerunds, simplify the if.s to @.s.
Older version:
First try at both coding in J as well as golfing.
g=:4 :'(+/,x>/y)>+/,y>/x'
h=:4 :'(,+/~x)g,+/~y'
f=: 3 :0
'a b c'=:y
if. (b g a)*(c g b)*a g c do.
a=.2{y
c=.0{y
end.
if. (a g b)*(b g c)*c g a do.
if. (a h b)*(b h c)*c h a do.
'strongly nontransitive'
elseif. (b h a)*(c h b)*a h c do.
'Grime-nontransitive'
elseif. do.
'nontransitive'
end.
else.
'none'
end.
)

Run it using a syntax similar to following (extra spaces for clarity):
f 3 6 $          1 1 9 17 17 21, 1 5 5 13 21 21, 5 5 13 13 13 17

Explanation:
g is defined as a diad taking two arrays that tells if first dice beats second dice
h is defined as a diad taking two arrays that tells if throwing twice and summing, does first dice beat second
f is a monad that takes a table and returns a string with the right answer
Edit: Fix a mistake in Grime-nontransitive condition (replacing , with *)

I would love any suggestions for improvement. :)

@MartinBüttner, I had initially tried that, but didn't know how to concatenate over several lines (or sentences, as it is known in J) without increasing code length much more... learning about "gerunds" led me to make the many sentences into one which ends up shortening the code as well...

Matlab (427)
It is not that short and I am sure it can be golfed a lot more, I just tried to solve this challenge because I thought it was a very fun task, so thanks @MartinBüttner for creating this challenge!
a=input();b=input();c=input();
m = 'non';l=@(a)ones(numel(a),1)*a;n=@(a,b)sum(sum(l(a)>l(b)'));g=@(a,b)n(a,b)>n(b,a);s=@(a,b,c)sum([g(a,b),g(b,c),g(c,a)]);
x=s(a,b,c);y=s(a,c,b);if x~=3 && y~=3;m=[m,'e'];else m=[m,'transitive'];o=ones(6,1);a=o*a;a=a+a';a=a(:)';b=o*b;b=b+b';b=b(:)';c=o*c;c=c+c';c=c(:)';u=s(a,b,c);
v=s(a,c,b);if u==3|| v==3;if x==3&&u==3 || y==3&&v==3 m=['strongly ',m];else m=['Grime-',m];end;end;end;disp(m);

Here the full length code with some comments if you want to try to understand what's going on. I included some test cases hare and excluced the input commands:
%nontransitive
% a = [1 2 2 4 6 6];
% b = [1 2 3 5 5 5];
% c = [2 3 4 4 4 4];

%none
% a = [1 2 3 4 5 6];
% b = [6 5 4 3 2 1];
% c = [1 3 5 2 4 6];

%grime nontransitive
% a = [3 3 3 3 3 6];
% b = [2 2 2 5 5 5];
% c = [1 4 4 4 4 4];

%strongly nontransitive
% a = [2 2 2 5 5 5];
% b = [2 3 3 3 5 5];
% c = [1 1 4 5 5 5];

m = 'non';

l=@(a)ones(numel(a),1)*a;
n=@(a,b)sum(sum(l(a)>l(b)'));
%input as row vector, tests whether the left one beats the right one:
g=@(a,b)n(a,b)>n(b,a);
s=@(a,b,c)sum([g(a,b),g(b,c),g(c,a)]);
%if one of those x,y has the value 3, we'll have intransitivity
x=s(a,b,c);
y=s(a,c,b);
if x~=3 && y~=3 %nontransitive
    m=[m,'e'];
else %transitive
    m=[m,'transitive'];
    o=ones(6,1);
    a=o*a;a=a+a';a=a(:)'; %all possible sums of two elements of a
    b=o*b;b=b+b';b=b(:)';
    c=o*c;c=c+c';c=c(:)';
    u=s(a,b,c);
    v=s(a,c,b);

    %again: is u or v equal to 3 then we have transitivity
    if u==3 || v==3 %grime OR strongly
        % if e.g. x==3 and u==3 then the 'intransitivity' is in the same
        % 'order', that means stronlgy transitive
        if x==3 && u==3 || y==3 && v==3%strongly
            m=['strongly ',m];
        else %grime
            m=['Grime-',m];
        end
    end
end

disp(m);

Isn't it shorter if you read an array one input() and then assign the three elements to a,b,c? Also, please use the exact strings in the spec (none, nontransitive, and capitalised Grime)... should probably even save you bytes.

Yeah this would be probably shorter, I'll take a look at that. The strings will be exactly those I just removed the disp commands in the long version, they were just for testing the program, but the final message is stored in m. And I corrected the G.

Pyth 129 133
Lmsd^b2Msmsm>bkGHDPNK-ghNeNgeNhNR?^tZ<KZKZAGHmsdCm,PkP,yhkyekm,@Qb@QhbUQ?"none"|!G%G3s[*!+GH"Grime-"*qGH"strongly ""nontransitive

Try it here, or at least you could, but the online eval doesn't seem to like lists of lists :( If you want to try it there, manually store a list of 3 dice into a variable not used by the program and then replace all instances of Q with that variable. A sample initialization:
J[[3 3 3 3 3 6)[2 2 2 5 5 5)[1 4 4 4 4 4))

This passes all of Martin's test cases, I haven't the heart go through all of Peter's cases :P
Explanation (this is gonna be a doozy)
Lmsd^b2

Pretty simple, makes a function y that returns the sum of each Cartesian pair of values in an iterable. Equivalent to: def y(b):return map(lambda d:sum(d),product(b,repeats=2)). This is used to create many-sided dies that simulate throwing the regular dies twice.
Msmsm>bkGH

Defines a function g of 2 arguments that returns how many times a die beats another. Equivalent to def g(G,H):return sum(map(lambda k:sum(map(lambda b:b>k,G)),H).
DPNK-ghNeNgeNhNR?^tZ<KZKZ

Defines a funtion P that takes a list of two dice as its argument. This returns -1 if the first die 'loses', 0 for a tie and 1 if the first die 'wins'. Equivalent to:
def P(N):
 K=g(N[0],N[-1]) - g(N[-1],N[0])
 return -1**(K<0) if K else 0

The AGH assigns acts like a python 2-tuple assignment. Essentially G,H=(result)
msdCm,PkP,yhkyekm,@Qb@QhbUQ

Going to explain backwards through the maps. m,@Qb@QhbUQ iterates over b=0..2 and generates 2-tuples of dice with index b and index b+1. This gives us dice (A,B),(B,C),(C,A) (pyth automatically mods indexes by the length of the list).
Next, m,PkP,yhkyek iterates over the result of the previous map, with each dice pair being stored in k over each run. Returns tuple(P(k),P(tuple(y(k[0]),y(k[-1])))) for each value. That boils down to `((A beats B?, 2*A beats 2*B), (B beats C?, 2*B beats..)).
Finally, msdC sums the values of the previous map after it has been zipped. The zip causes all of the single dice 'beats' values in the first tuple, and the double dice values in the second.
?"none"|!G%G3s[*!+GH"Grime-"*qGH"strongly ""nontransitive

A gross thing that prints out the results. If G is 0 or not divisible by 3, this catches bot +/- 3, (|!G%G3), prints none, otherwise prints the sum of the follwing list: [not(G+H)*"Grime",(G==H)*"strongly ","nontransitive"]. I think the booleans are fairly self-explanatory with regard to the definitions in the question. Do note that G cannot be zero here, as that is caught by the previous check.

J (204)
Way too long, could probably be golfed a lot by having a more efficient system for picking the right string.
f=:3 :'(<,>)/"1+/"2>"1,"2(<,>)/L:0{(,.(1&|.))y'
n=:'nontransitive'
d=:3 :0
if.+/*/a=.f y do.+/*/b=.f<"1>,"2+/L:0{,.~y if.a-:b do.'strongly ',n elseif.a-:-.b do.'Grime-',n elseif.do.n end.else.'none'end.
)

JavaScript - 276 bytes
function(l){r=function(i){return l[i][Math.random()*6|0]};p=q=0;for(i=0;j=(i+1)%3,i<3;++i)for(k=0;k<1e5;++k){p+=(r(i)>r(j))-(r(i)<r(j));q+=(r(i)+r(i)>r(j)+r(j))-(r(i)+r(i)<r(j)+r(j))}alert((a=Math.abs)(p)>5e3?((a(q)>5e3?p*q>0?'strongly ':'Grime-':'')+'nontransitive'):'none')}

I'm not really good in probability, so to be sure of my results, I prefer to just throw the dice hundreds of thousands times.
The expression evaluates to a function, that should be called with only one argument: an array of three arrays of integers. Check the Fiddle to be able to run the code by yourself.
Here is the ungolfed version:
function (diceList) {
    var getRandomValue = function (idDie) {
        return diceList[idDie][Math.floor(Math.random() * 6)];
    };

    var probabilitySimpleThrow = 0;
    var probabilityDoubleThrow = 0;

    for (var idDieA = 0; idDieA < 3; ++idDieA)
    {
        var idDieB = (idDieA + 1) % 3;
        for (var idThrow = 0; idThrow < 1e5; ++idThrow)
        {
            probabilitySimpleThrow += getRandomValue(idDieA) > getRandomValue(idDieB);
            probabilitySimpleThrow -= getRandomValue(idDieA) < getRandomValue(idDieB);

            probabilityDoubleThrow += getRandomValue(idDieA) + getRandomValue(idDieA) > getRandomValue(idDieB) + getRandomValue(idDieB);
            probabilityDoubleThrow -= getRandomValue(idDieA) + getRandomValue(idDieA) < getRandomValue(idDieB) + getRandomValue(idDieB);
        }
    }

    if (Math.abs(probabilitySimpleThrow) > 5e3) {
        if (Math.abs(probabilityDoubleThrow) > 5e3) {
            if (probabilitySimpleThrow * probabilityDoubleThrow > 0) {
                var result = 'strongly ';
            }
            else {
                var result = 'Grime-';
            }
        }
        else {
            var result = '';
        }

        result += 'nontransitive';
    }
    else {
        var result = 'none';
    }

    alert(result);
}

Hm, I don't think this is really in the spirit of the challenge. You basically turned it from a probability theory challenge into a statistics challenge. ;) ... Instead of random throws, you could simply enumerate all possible throws exactly once. That would give you the exact results (and would run much faster).

I'll check if this leads to a more concise script. Thanks for your advice :).


text:
Determine dice value from side view
Write program or function which will take left and right value of dice as integers (1-6) and return value on top.
Dice layout:
    +---+
    | 1 |
+---+---+---+---+
| 2 | 3 | 5 | 4 |
+---+---+---+---+
    | 6 |
    +---+

  ,^.
<´ 5 `>  <-- Top value
|`._,´|
.6 | 4,  <-- Side values
 `.|,´

So inputting 6 4 will return 5.
Order is important:
2 3 -> 1
3 2 -> 6

Program doesn't have to work with invalid input values.
To discourage obvious approach (using table with all combinations), using any builtin text encoding or de/compression routines or base encoding or anything else similar to reduce size is not allowed. Note that using table is still allowed and rolling your own decompression is allowed too, as long as it's not done using some ready library function.
For reference purposes, here's a table of all combinations (i.e. all possible inputs and outputs):
23, 35, 42, 54 -> 1
14, 31, 46, 63 -> 2
12, 26, 51, 65 -> 3
15, 21, 56, 62 -> 4
13, 36, 41, 64 -> 5
24, 32, 45, 53 -> 6

Shortest code wins, and standard loopholes apply.

so I can use a table with all combination - 1 ^^?

Yes, you can use table. But you cannot use builtin compression routines to make it smaller.

Python, 30
lambda a,b:a^b^7*(2<a*a*b%7<5)

No lookups, just bit bashing.
The opposite faces come in pairs that are three-bit complements of each other, meaning that they XOR to 7.
1,6
2,5
3,4

Given two faces from one set, we want to get a face from the other set. For (1,2,3), we can do this with XOR (^). So, ^ gives the right answer up to three-bit complement, meaning x^7. We can conditionally complement by x^7*_.
To decide whether or not to take the complement (XOR with 7), we check whether the triplet violates the right-hand rule. That means, that a,b goes in the reverse cyclic order of
1,6
2,5
3,4

treating each line as one of the three categories. Since the elements in each line are negatives mod 7, we can "hash" them by doing x*x%7.
1,6 -> 1
2,5 -> 4
3,4 -> 2

Each line is obtained from the cyclically previous by multiplying by 4 modulo 7, so we can check whether this relationship holds for (b,a) to decide whether to complement: a*a%7==b*b*4%7.
This is equivalent to checking whether, modulo 7, a**2 * b**(-2) equals 4. Since b**6 equals 1 modulo 6, this is equivalent to a**2 * b**4. Since the other possible value is 2 (by checking cases), we can check if it's 4 by comparing to 3.

CJam - 26 - ri:Ari:B^7A7A-e<B7B-e<)=*^

I can save a char off of min(a,7-a) by doing a^7*(a>3), but I feel like there should be a yet shorter way. Any ideas?

Ooh, there's a/4*7^a...

I never realized that dice face bits had this property. Nice one!

@user694733 It works out very fortuitously that 6 is two below a power of two.

Your 33 byte version just saves 2 bytes in CJam - l~:B\:A^7AA*7%BB4**7%=*^ from the earlier translation

There's a nice polynomial expression modulo 7 for the third side given two sides a and b.
$${3(a^3b - ab^3) \mod 7}$$
or factored
$${3ab(a^2-b^2) \mod 7}$$
The modulo 7 maps to a remainder in {0,1,2,3,4,5,6}.
I explain why it works in this Math SE answer, though I do think there probably is a cleaner argument I'm missing. The only other two-term polynomial that works is
$${(3a^5b^5 - a^3b) \mod 7}$$
which I originally found by transforming my bit-bashing into arithmetic operations, then did a brute-force search over polynomials of this form to find the nicer one.
Please feel free to add ports of this into your favorite language; this is a CW post.
J, 9 by Synthetica
7|3***+*-

See my post
Dyalog APL, 9 by ngn (typo fixed by Adám)
7|3×××+×-

Blatantly stolen from above J answer.
TI-Basic, 14 by Timtech
7fPart((A³B-AB³)/21

Pyth, 16 by FryAmTheEggman
M%*3-*H^G3*^H3G7

Defines a function g of two values.
Golfscript, 18 by Peter Taylor (old polynomial)
~1$*.5?3*@.*@*- 7%

CJam, 18 by Martin Büttner (ported from Peter's GolfScript) (old polynomial)
l~1$*_5#3*@_*@*m7%

Mathematica, 20 by Martin Büttner
Mod[+##(#-#2)3##,7]&

Yes, that's a unary plus, and no, there's no shorter way that doesn't use a unary plus.
dc, 21 by Toby Speight
sb7+d3^lb*rlb3^*-3*7%

I have to add 7 to a to ensure the difference is always positive (dc has a signed % operator).
Julia, 24 23 21 by Martin Büttner, fixed by MarcMush
a\b=(3a^5*b^4-a^3)b%7

Try it online!
CoffeeScript, 28 26 by rink.attendant.6
x=(a,b)->3*a*b*(a*a-b*b)%7

JavaScript (ES6), 28 26 by rink.attendant.6
x=(a,b)=>3*a*b*(a*a-b*b)%7

Essentially the same as CoffeeScript.
Python 28, by xnor
lambda a,b:3*a*b*(a*a-b*b)%7

Bash, 31
Nothing special:
echo $[3*($1**3*$2-$1*$2**3)%7]

or alternatively:
echo $[3*$1*$2*($1*$1-$2*$2)%7]

Another (longer but perhaps interesting) approach.
Nim, 36 by Sillesta
proc(x,y:int):int=3*x*y*(x*x-y*y)%%7

Java 7, 46 44 by rink.attendant.6
int f(int a,int b){return(a*a-b*b)*a*b*3%7;}

Java 8, 25 23 by Kevin Cruijssen
a->b->(a*a-b*b)*a*b*3%7

PHP, 49 47 by rink.attendant.6
function x($a,$b){echo($a*$a-$b*$b)*3*$a*$b%7;}

Batch, 52 unclemeat
set/aa=(3*(%1*%1*%1*%2-%1*%2*%2*%2)%%7+7)%%7
echo %a%

CMD does not support true modulus natively (so can't handle negative numbers) - hence %%7+7)%%7.
LESS (as a parametric mixin), 62 60 by rink.attendant.6
.x(@a,@b){@r:mod(3*@a*@b*(@a*@a-@b*@b),7);content:~"'@{r}'"}

See my post below.
05AB1E, 10 8 by Emigna (-2 bytes by Kevin Cruijssen)
nÆs`3P7%

Try it online.
Haskell, 31 27 25 by Generic Display Name
a#b=3*a*b*(a*a-b*b)`mod`7

Try it online!
Excel, 27 by by Wernisch
=MOD(3*(A1^3*B1-A1*B1^3),7)

Excel VBA, 25 by Taylor Raine
?3*[A1^3*B1-A1*B1^3]Mod 7

Forth (gforth) 41 by reffu
: f 2>r 2r@ * 2r@ + 2r> - 3 * * * 7 mod ;

Try it online!
C#, 23 by Kevin Cruijssen
a=>b=>(a*a-b*b)*a*b*3%7

Jelly, 9 by caird coinheringaahing
_×+×××3%7

Try it online!
Exactly the same as the J and APL answers, but in reverse

FWIW, (ab)**5 % 7 == (ab)**-1 % 7 == a^b^7 for all a,b in 1..6 such that a != b and a+b != 7.

@PeterTaylor Indeed, I found that expression by using **5 as a proxy for inverting modulo 7.

mathematics ftw :) funny how the formulas like to work out in those cases

@rink.attendant.6 You can avoid having to take the mod of negative numbers by doing a*a + 6*b*b, guaranteeing a positive output. It's equivalent mod 7.

I've been losing sleep over the "why" of this amazing polynomial.  Perhaps the math.SE folks can help.  http://math.stackexchange.com/questions/1101870/derivation-of-dice-sides-polynimial

I wrote up a derivation on math.SE: http://math.stackexchange.com/a/1101984/24654

You can rewrite the APL train as 7|3×××+×-, pronounced: 7-remainder of 3 times the product times the sum times the difference (between the two numbers).

CJam, 43 28 bytes
No idea if a full table based approach will be shorter, but here goes:
l_~^56213641532453s@S-#)g7*^

Input like
2 3

Output:
1

This is a mixture of my previous algorithm to determine the correct face out of 2 faces and xnor's approach of xors.
Try it online here

Could you explain how this works? Same idea as ep1024 had?

@user694733 not at all. Explanation added.

Yeah, I saw the time. I was just wondering if it's similar, because he had explanation on it, and I have no idea how CJam works.

@Optimizer I want to get started on CJam too, any general direction you can point me at for tutorials etc? I see some examples but they hardly have any explaination :(

The link above have some examples and a link to the main website which has explanations of the language keywords. Other than that, search here with cjam keyword to learn from existing answers.

LESS, 62 bytes
Uses the algorithm in this post:
.x(@a,@b){@r:mod(3*@a*@b*(@a*@a+6*@b*@b),7);content:~"'@{r}'"}

It could be shorter if the integer value was used, but to get it to display I needed to use the CSS content property which required variable interpolation.
Nonetheless, it's not often that a CSS preprocessor language is used for code golf!
To use with some HTML, you'd do this:
p::after { .x(1, 3); }

<p>Number on top: </p>

Pyth, 30 bytes
K"23542 31463 12651 "h/x+K_Kz6

Requires the two digits as input, with no space in between (ex. 23 not 2 3).
Explanation:
Any two digit sequence that lies within 23542 represents two sides that have 1 on top. Likewise, 31463 for 2, etc. Reversing this string gives the sequences for 4 through 6.
This code just does a lookup in the string "23542 31463 12651  15621 36413 24532", divides the index by 6, and increments to determine what the top side must be.
Test online here.
Thanks to @FryAmTheEggman for tips on golfing this.

Some pyth-related golfs: J"23542 31463 12651 "h/x+J_Jscz)6 Ping me if some of it is confusing. Prefer K and J for assigning values, h is unary +1, s on a list of strings is jk. (Also, if allowed, just using a string like 23 as the input would be best)

Takes a similar approach as es1024 with a different lookup string:
JavaScript (ES6), 73 72 61 bytes
t=(l,r)=>-~('354233146312651215623641332453'.search([l]+r)/5)

JavaScript (ES5), 88 87 77 bytes
function t(l,r){return -~('354233146312651215623641332453'.indexOf([l]+r)/5)}

CoffeeScript, 71 62 bytes
And just for the fun of it, the code is 1 byte shorter in CoffeeScript as ES6 due to the permitted omission of parentheses
Due to the use of the -~ trick, this turned out to be the same number of characters as ES6.
t=(l,r)->-~('354233146312651215623641332453'.indexOf([l]+r)/5)

Save 1 byte: ''+l+r => [l]+r

@edc65 Thanks! Oh how JavaScript behaves when adding different types

Yes, operator + is weird. But what about operator ~? 1+Math.floor => -~. Also, search instead of indexOf.

Interesting. And I knew about search but it's only for ES6.

Actually, String.prototype.search has been part of JavaScript since ECMAScript 3rd Edition, so you can change your answer. https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/String/search#Specifications

J (9)
Uses the algorithm from this post.
7|3***+*-

Tree graph of the function (might clear some things up):
    f=:7|3***+*-
    f
7 | 3 * * * + * -
   5 !: 4 < 'f'
  ┌─ 7
  ├─ |
──┤   ┌─ 3
  │   ├─ *
  └───┤   ┌─ *
      │   ├─ *
      └───┤   ┌─ +
          └───┼─ *
              └─ -

Demonstration:
   3 f 5
1
   4 f 6
2
   2 f 6
3
   2 f 1
4
   1 f 2
3
   4 f 5
6

Lua 118
Had to restore last version because of a bug I can't find, nor have time to look for it.
z=io.read;o={"","","34","5 2","2165","46 13",""," 31064","  5612","   2 5","    43"}a=z();b=z();print(o[a+b]:sub(a,a))

Still working on this though.

I tested this here, and it seems to return 4 with 2 3.

indeed.. weird. ill look into it.

@user694733 Fixed it :)

PHP, 81 bytes
Same as my JavaScript solution:
function t($l,$r){echo(int)(1+strpos('354233146312651215623641332453',$l.$r)/5);}

JavaScript (ES6), 79 bytes
Not the shortest but I tried a different approach than currently in the answers.
f=(a,b)=>[a,b,7-a,7-b].reduce((p,v,i,r)=>p?p:'2312132'.indexOf([v]+r[i+1])+1,0)

Lua, 89 bytes
A straightforward port of xnor's Python solution.
x=require('bit32').bxor
function(a,b)c=a*a*b%7;return x(a,x(b,2<c and c<5 and 7 or 0))end

Bash, 85
This doesn't compete golf-wise with @xnor's magic polynomial.  But I think this is another interesting way to calculate the answer:
g(){
((d[$1$2]))||{
d[$1$2]=$3
g $2 $1 $[7-$3]
g $2 $3 $1
}
}
g 1 2 3
echo ${d[$1$2]}

Specifically we know the the following about dice:

If the left face is 1 and the right face is 2, then the top face is 3
Rotation around opposite vertices by 120° gives some more triples of face values.  E.g we rotate {l=1,r=2,t=3} once we get {l=2,r=3,t=1} and rotating again we get {l=3,r=1,t=2}
The sum of opposite faces is always 7

Combining the above recursively (using {1,2,3} hardcoded as a starting point), we can generate the entire mapping of {l,r}->t for all possible values.  This answer defines a recursive function g() that populates a full array such that d[lr]=t.  The recursive function is initially called with {1,2,3} and recurses all over the whole cube until there are no more array elements that have not been set.  The function recurses into itself in two ways:

with l and r swapped and t subtracted from 7 (opposite faces)
with {l,r,t} rotated to {r,t,l}

It then does a simple array lookup of the values required.

Dyalog APL, 9 bytes
Blatant character substitution of ɐɔıʇǝɥʇuʎs's J solution:
7|3×××+×-

Edit: I later noticed that this exact solution was suggested by ngn on Jan 17, 15.
  the division remainder when divided by seven of
  |        three times
  |        | the product of the arguments
  |        |   times   \┌───┐
  |        |     \  ┌───┤ × │
┌────┐   ┌────┐   ┌─┴─┐ └───┘ ┌───┐
│ 7| ├───┤ 3× ├───┤ × │   ┌───┤ + │ - the sum of the arguments
└────┘   └────┘   └─┬─┘ ┌─┴─┐ └───┘
                    └───┤ × │ ---- times
                        └─┬─┘ ┌───┐
                          └───┤ - │ - the difference between the arguments
                              └───┘

TryAPL online!

Julia, 26 bytes
f(a,b)=a$b$7*(2<a^2*b%7<5)

or
f(a,b)=(3*a^5*b^5-a^3*b)%7

or
f(a,b)=3*a*b*(a+b)*(a-b)%7

Common Lisp, 45 bytes
(lambda(a b)(mod(* 3 a b(-(* a a)(* b b)))7))

Try it online!
Port of xnor solution.

C# (Visual C# Interactive Compiler), 49 bytes
x=>1+("3542331463126512156236413"+x).IndexOf(x)/5

Try it online!
-1 byte thanks to @GB!
The input is a 2 character string containing the visible left and right digits.
Below is the solution that I came up with independently. Leveraging the lookup string from rink.attendant.6's JavaScript answer, I was able to shave off 5 bytes (but now our answers are pretty similar ;)
C# (Visual C# Interactive Compiler), 55 bytes
x=>1+"42354 31463 51265 21562 41364 24532".IndexOf(x)/6

Try it online!

49 bytes by using ("3542331463126512156236413"+x) instead of the full string

source: Stack Exchange

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

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

sort: votes


text:
0-1 Maximal Phase Counter
Consider an array of bits, say
1 1 1 0 0 0 0 1 0 0 1 0 1 1 1 1 1 0 1 0

We call a contiguous subarray of length ≥ 5 a phase if at least 85% of the bits are the same and the first/last bits are both equal to the majority bit. Furthermore, we call a phase maximal if it is not a strict subarray of some other phase.
Here are the maximal phases of the above example:
1 1 1 0 0 0 0 1 0 0 1 0 1 1 1 1 1 0 1 0
      -------------
                    -------------
                        -------------

As you can see, there are 3 maximal phases. On the other hand, this
1 1 1 0 0 0 0 1 0 0 1 0 1 1 1 1 1 0 1 0
                        ---------

is not a maximal phase as it is a strict subarray of at least one other phase.
The challenge
Input is a sequence of ≥ 5 bits via STDIN, command line or function argument. The bits may come in as a string or an array.
You are to output a single integer, the number of maximal phases for the array, either printed via STDOUT or returned from a function.
Scoring
This is code-golf so the program in the fewest bytes wins.
Test cases
0 1 0 1 0 -> 0
0 0 0 0 0 -> 1
0 0 0 0 1 0 1 1 1 1 -> 0
0 0 0 0 0 1 0 1 1 1 1 1 -> 2
1 0 0 0 0 0 0 0 0 0 0 0 0 1 0 -> 1
0 0 0 0 0 1 0 0 0 0 0 1 0 0 0 0 0 1 0 -> 2
0 0 0 0 0 1 0 0 0 0 0 1 0 0 0 0 0 1 0 0 -> 1
0 1 0 1 0 0 1 0 1 0 1 0 0 0 1 1 1 1 0 1 0 0 1 1 0 0 0 1 1 0 -> 0
1 1 1 1 1 0 0 0 0 0 1 1 1 1 1 0 0 1 0 0 0 0 0 0 0 0 1 1 0 1 -> 4
0 1 1 0 0 0 0 0 0 0 0 0 0 0 1 0 1 1 1 1 1 1 1 0 1 0 0 0 0 0 -> 5

Here's the explanation for the last case:
0 1 1 0 0 0 0 0 0 0 0 0 0 0 1 0 1 1 1 1 1 1 1 0 1 0 0 0 0 0
---------------------------
      -------------------------
                            -----------------
                                -----------------
                                              -------------

Fun fact: This challenge came about from a data mining problem with the goal of detecting change in temporal data.

Question about when its a contiguous subarray. length ≥ 5 a phase if at least 85% of the bits are the same Lets say we have a length 5 like 1 1 0 1 1 85% of 5 is 4.25 which is So length 5 would be impossible or should we round that down to 4?

@TeunPronk It means that length 5 is impossible unless all the bits are the same

I was about to edit my comment to add that to it, so no rounding down it is :)

So are you meant to find as many subarrays as possible or find arrays as big as possible? because I find more than 1 in testcase 5 (not by code but by looking)

@TeunPronk you are to find as many as possible which are not entirely contained in bigger ones. There's only one such array for the 5th test case, starting at the first 0 and ending at the last one.

@Sp3000 ah ok, because you can make 8 arrays of 5x0 in testcase 5 if you ignore the bigger one. But I suppose youre not allowed to ignore any subarrays :)

Dyalog APL, 62 characters
{≢∪0~⍨+/∨⍀∨\⌽∘.{((⊃=⊃∘⌽)∧(.85≤(+/⊢=⊃)÷≢)∧5≤≢)(⍺-1)↓⍵↑a}⍨⍳⍴a←⍵}
Similar to Zgarb's solution but golfed a little further.

Python 2, 149 bytes
a=input()
l=len(a)
n=p=0
for i in range(l):
 for j in range(l-1,i+3,-1):
  if(j>p)>(.15<sum(a[i:j+1])/(j+1.-i)+a[i]+a[j]<2.85):n+=1;p=j;break
print n

The first loop scans across the array from left to right. Each bit, indexed by i, is checked to see if it could be the first bit in a maximal phase.
This is done by the inner loop, which scans from right to left. If the subarray between i and j is a phase, we increase the counter and move on. Otherwise, we keep going until the subarray becomes too small or j reaches the end of the previous maximal phase.
1 1 1 0 0 0 0 1 0 0 1 0 1 1 1 1 1 0 1 0
i ->                               <- j

Example:
$ python phase.py
[1, 1, 1, 0, 0, 0, 0, 1, 0, 0, 1, 0, 1, 1, 1, 1, 1, 0, 1, 0]
3

Python 2, 144
Enter input in the form [0,1,0,1,0].
a=input()
o=[2];i=-1
while a[i:]:
 j=len(a);i+=1
 while j>i+4:o+=sum(j>max(o)>x==a[i]==a[j-1]for x in a[i:j])*20/(j-i)/17*[j];j-=1
print~-len(o)

Subsequences are checked with ordering by increasing initial element, then decreasing length. In this way, it is known that a new subsequence is not a subsequence of a previous subsequence iff the index of its last element is greater than any index of a previously found sequence's last element.

Dyalog APL, 86 bytes*
{+/∨/¨∪↓∨⍀∨\{⊃({(.5>|k-⍵)∧.35≤|.5-⍵}(+/÷⍴)⍵)∧(5≤⍴⍵)∧(⊃⌽⍵)=k←⊃⍵}¨⌽∘.{(⍺-1)↓⍵↑t}⍨⍳⍴t←⍵}

Try it here. Usage:
   f ← {+/∨/¨∪↓∨⍀∨\{⊃({(.5>|k-⍵)∧.35≤|.5-⍵}(+/÷⍴)⍵)∧(5≤⍴⍵)∧(⊃⌽⍵)=k←⊃⍵}¨⌽∘.{(⍺-1)↓⍵↑t}⍨⍳⍴t←⍵}
   f 0 0 0 0 0 1 0 1 1 1 1 1
2

This can probably be golfed quite a bit, especially the middle part, where the phase condition is checked.
Explanation
I first collect the substrings of the input vector into a matrix, where the upper left corner contains the whole input, using ⌽∘.{(⍺-1)↓⍵↑t}⍨⍳⍴t←⍵. For the input 0 0 0 0 0 1 0, this matrix is
┌───────────────┬─────────────┬───────────┬─────────┬───────┬─────┬───┬─┐
│1 0 0 0 0 0 1 0│1 0 0 0 0 0 1│1 0 0 0 0 0│1 0 0 0 0│1 0 0 0│1 0 0│1 0│1│
├───────────────┼─────────────┼───────────┼─────────┼───────┼─────┼───┼─┤
│0 0 0 0 0 1 0  │0 0 0 0 0 1  │0 0 0 0 0  │0 0 0 0  │0 0 0  │0 0  │0  │ │
├───────────────┼─────────────┼───────────┼─────────┼───────┼─────┼───┼─┤
│0 0 0 0 1 0    │0 0 0 0 1    │0 0 0 0    │0 0 0    │0 0    │0    │   │ │
├───────────────┼─────────────┼───────────┼─────────┼───────┼─────┼───┼─┤
│0 0 0 1 0      │0 0 0 1      │0 0 0      │0 0      │0      │     │   │ │
├───────────────┼─────────────┼───────────┼─────────┼───────┼─────┼───┼─┤
│0 0 1 0        │0 0 1        │0 0        │0        │       │     │   │ │
├───────────────┼─────────────┼───────────┼─────────┼───────┼─────┼───┼─┤
│0 1 0          │0 1          │0          │         │       │     │   │ │
├───────────────┼─────────────┼───────────┼─────────┼───────┼─────┼───┼─┤
│1 0            │1            │           │         │       │     │   │ │
├───────────────┼─────────────┼───────────┼─────────┼───────┼─────┼───┼─┤
│0              │             │           │         │       │     │   │ │
└───────────────┴─────────────┴───────────┴─────────┴───────┴─────┴───┴─┘

Then I map the condition of being a phase over it, resulting in the 0-1-matrix
0 0 0 0 0 0 0 0
1 0 1 0 0 0 0 0
0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0

To get the number of maximal phases, I flood the 1's to the right and down using ∨⍀∨\,
0 0 0 0 0 0 0 0
1 1 1 1 1 1 1 1
1 1 1 1 1 1 1 1
1 1 1 1 1 1 1 1
1 1 1 1 1 1 1 1
1 1 1 1 1 1 1 1
1 1 1 1 1 1 1 1
1 1 1 1 1 1 1 1

collect the unique rows with ∪↓,
┌───────────────┬───────────────┐
│0 0 0 0 0 0 0 0│1 1 1 1 1 1 1 1│
└───────────────┴───────────────┘

and count those that contain at least one 1 using +/∨/¨.
*There exists a standard 1-byte encoding for APL.

Well, its hard to explain what I am asking. If you had a better explanation of the code, then I could rephrase. I will delete my comment for now.

@Optimizer I expanded the explanation.

Clojure, 302
(defn p[v l](if(or(<(count v)5)(= 0 l))nil(if((fn[v](let[f(first v)c(apply + v)o(count v)r(/ c o)t(+ f f r)](and(= f(last v))(or(> t 2.85)(< t 0.15)))))v)0(let[r(p(vec(drop-last v))(dec l))](if r(+ r 1)r)))))(defn s[v l c](if(empty? v)c(let[n(p v l)](if n(s(vec(rest v))n(inc c))(s(vec(rest v))l c)))))

and the slightly ungolfed version
(defn is-phase [vector]
  (let [f (first vector)
        c (apply + vector)
        o (count vector)
        r (/ c o)
        t (+ f f r)]
    (and (= f (last vector))
         (or (> t 2.85) (< t 0.15)))))
(defn phase-index [vector last]
  (if (or (<(count vector)5)(= 0 last)) nil
    (if (is-phase vector) 0
      (let [r (phase-index (vec(drop-last vector)) (dec last))]
        (if r (+ r 1) r)))))
(defn phase-count [vector last count]
  (if (empty? vector) count
    (let [n (phase-index vector last)]
         (if n (phase-count (vec(rest vector)) n (inc count))
             (phase-count (vec(rest vector)) last count)))))

callable like this: (s [0 1 0 1 0] 10 0).
It requires a few extra arguments, but I could get rid of those with an extra 20 characters.

JavaScript (ES6) 141
@grc's algorithm ported to JavaScript
Input can be a string or an array
F=b=>
  (l=>{
    for(c=e=i=0;i<l;++i)
      for(j=l;j>i+4&j>e;--j)
        (k=0,[for(d of b.slice(i,j))k+=d==b[i]],k<(j-i)*.85)|b[i]-b[j-1]||(++c,e=j)
  })(b.length)|c

Test In FireFox / FireBug console
;['01010', '00000', '0000101111',
'000001011111', '100000000000010',
'0000010000010000010', '00000100000100000100',
'010100101010001111010011000110',
'111110000011111001000000001101',
'011000000000001011111110100000'].forEach(t => console.log(t,F(t)))

Output
01010 0
00000 1
0000101111 0
000001011111 2
100000000000010 1
0000010000010000010 2
00000100000100000100 1
010100101010001111010011000110 0
111110000011111001000000001101 4
011000000000001011111110100000 5

JavaScript (ECMAScript 6), 148 139 Bytes
f=(s,l=0,e=0,p=0)=>{for(n=s.length,o=[j=0,y=0],i=l;i<n;++j>4&x==s[l]&i>e&c>=.85*j&&(e=i,y=1))c=++o[x=s[i++]];return l-n?f(s,l+1,e,p+y):p}

Recurses through the array and starts iteration at the last recursion index. Argument can be either an array or string.
f('011000000000001011111110100000'); //5

Some golf tricks: -11. f=(s,l=0,e=0,p=0)=>{for(n=s.length,o=[j=0,y=0],i=l;i<n;++j>4&x==s[l]&i>e&c>=.85*j&&(e=i,y=1))c=++o[x=s[i++]];return l-n?f(s,l+1,e,p+y):p}

CJam, 110 103 bytes
Pretttttty long. Can be golfed a lot.
q~_,,\f>{_,),5>\f<{:X)\0==X1b_X,.85*<!\.15X,*>!X0=!*\X0=*+&},:,W>U):U+}%{,(},_{{_W=IW=>\1bI1b>!&!},}fI,

Input is like
[0 1 1 0 0 0 0 0 0 0 0 0 0 0 1 0 1 1 1 1 1 1 1 0 1 0 0 0 0 0]

Output is the number of phases.
Try it online here

Wolfram - 131
{x_, X___}⊕{Y__, x_, y___}/;MemberQ[t={x, X, Y, x}, 1-x] && t~Count~x > .85 Length@t :=
  1 + {X, Y, x}⊕{y}
{_, X___}⊕y_ := {X}⊕y
{}⊕{y_, Y__} := {y}⊕{Y}
_⊕_ := 0

Example
{}⊕{1, 1, 1, 0, 0, 0, 0, 1, 0, 0, 1, 0, 1, 1, 1, 1, 1, 0, 1, 0}
> 3
{}⊕{0,1,1,0,0,0,0,0,0,0,0,0,0,0,1,0,1,1,1,1,1,1,1,0,1,0,0,0,0,0}
> 5

Java: 771 bytes
import java.util.*;public class A{static int[]a;static class b{int c,d,e,f,g,h;b(int i,int j){this.c=i;this.d=j;this.h=j-i+1;this.e=k();this.f=this.h-this.e;this.g=e>f?1:0;}
boolean l(b n){return this.c>=n.c&&this.d<=n.d;}
int k(){int o=0;for(int i=c;i<=d;i++){if(a[i]==1){o++;}}
return o;}
public boolean equals(Object o){b x=(b)o;return x.c==this.c&&x.d==this.d;}
float p(){if(g==0){return(float)f/h;}else{return(float)e/h;}}
boolean q(){float r=p();return a[c]==a[d]&&a[d]==g&&r>=0.85F;}}
static int s(int[]t){a=t;List<b>u=new ArrayList<>();for(int v=0;v<t.length-4;v++){int x=v+4;while(x<t.length){b y=new b(v,x);if(y.q()){u.add(y);}
x++;}}
List<b>a=new ArrayList<>();for(b c:u){for(b d:u){if(!c.equals(d)&&c.l(d)){a.add(c);break;}}}
u.removeAll(a);return u.size();}}

run by calling method s(int[] input)

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


text:
Retrograde morse (d)e(n)coder
This question is inspired by retrograde music. Retrograde music is a piece of music that can both be played normally (from the beginning to the end) as reversed (from the end the beginning). A similar thing exists in literature, this is called a semi-palindrome, e.g. "roma" and "amor".
Your task is to write a retrograde program. If executed normally it has to encode a string with the morse code, decode it when executed reversed.
Task
You're to write a program or function that accepts a string and outputs it's morse code encoding (STDIN and STDOUT are used in case of a program, a function receives it's input as a function argument and returns a string). However, when you run the reverse of the program, it works the same except it decodes the input. Note that you don't have to use the same programming language. The reversing of the program is done manually.
Details

Comments are not allowed in your program, as they would make this task very easy.
You have to use the international morse code. This includes letters, numbers and some punctuation. See the link for a complete list. No prosigns or special characters have to be supported. There's one exception mentioned in the edit.
You have to represent dots and dashes with . and -.
Letters are separated with  (spaces), words are separated with / (slashes).
You can choose to use either use lower or uppercase. However, you have to be consistent (if your program only uses uppercase, the reversed program must do so too).
You can assume the program will only receive valid input.

Example
Input of the normal program or output of the reversed program:
MORSE CODE?

Output of the normal program or input of the reversed program:
-- --- .-. ... . / -.-. --- -.. . ..--..

Score
Because I want to reward both clever (short) algorithms and creativity, Your score will be based upon your votes and the program length. Concretely, it will be 100 * amount of votes / program length (in bytes)
EDIT: The morse code site I mentioned uses the same code for opening and closing parentheses, however it's not my intention to let you implement a feature for recognizing this. So you have to use these more modern morse codes for the parentheses:
( = -.--.
) = -.--.-

CJam, 349 284 bytes
This is the encoder from plaintext to International Morse code:
L;"q['[,65>A,841306689079511650 64b:c]s"~"*S/as/'res]c:b46 056115970986603148,A>56,['[/,'c:+f34b4i%Ws;\\";L
2750763932992480612976738964894343100372667569857057816704667471637641979761595859190213443543359288493237588430216583759463627409436875398907
L;"\\;4b43f+:c',/erS/'/*S*"~"/Sq";L

The reverse string of which is:
L;"qS/"~"*S*/'/Sre/,'c:+f34b4;\\";L
7098935786349047263649573856120348857323948829533453443120919585951679791467361747664076187507589657662730013434984698376792160842992393670572
L;"\\;sW%i4b43f+:c',/['[,65>A,841306689079511650 64b:c]ser'/sa/S*"~"s]c:b46 056115970986603148,A>56,['[q";L

which decodes an International Morse Code representation back to plain text.
(New lines just for show)
This supports capital alphabets A-Z, number 0-9 and .,:?'-/()" punctuation marks, where Morse Code for ( and ) is same.
How it works:
The trick here is simple, CJam supports evaluation of any random string as a code using the operator ~. So if you have something like "code in a string"~"another code in a string", then when running normally, the first string will be evaluated while the second one will remain a string. But when running the reverse of the code, the second string will be evaluated, while the first will remain a string.
So now you just have to make sure that you have your code in the above format along with a logic to remove the second string while running in normal fashion and the first string while running the reverse code. This gives us something like:
];"code for encoding to morse"~"reverse of code for decoding from morse";]

whose reverse will be
];"code for decoding from morse"~"reverse of code for encoding to morse";]

This works like:
];                                "Create an empty array and pop it from stack";
  "code 1"~                       "Put a string with code 1 and evaluate it";
           "code 2";              "Put the string for code 2 and pop it from stack";
                    ]             "Wrap everything in an array. Noop as last operation";

The reverse of it is just code 1 replaced by reverse of code 2 and vice-versa, so it works in a similar manner.
Now the actual code which encodes/decodes is a simple transliteration from the plaintext to morse and vice-versa.
Try it online here

A string followed by a semicolon is the standard CJam comment, so I think this falls foul of the prohibition "Comments are not allowed in your program, as they would make this task very easy."

@PeterTaylor its not a standard CJam comment. CJam does not have comments, so the only option to simulate comments is a string followed by a semi colon. Also, that is just the idea of the approach, I can achieve similar results by 0* too

Well, I'll let you make a counter-case rather than play devil's advocate myself.

@Deformyer from your edit : So you can use these more modern morse codes for the parentheses . It does not say that everyone has to put this new morse code for ). Sounds more like an optional thing to me.

@Deformyer I don't see a point in adding a compulsory rule so late. I have changed it for now, but any further rule changes will simply make me delete my answer.

@Optimizer I'm sorry but after encoding and decoding, () would become ((, this seemed wrong to me so I made an  edit.

Look ma, no eval! :)

Perl 5: too long to care (740 though)
Just wanted to see if it will be possible to write this in a language with non single character statements. The result is not pretty, but works. Most of the code is used in both decoder and encoder, but the eval+'{code}' trick shows a loophole which could be used to write completely separate code for decoder and encoder.
Fixed all known problems. Supports both lower and upper case input with all punctuation characters mentioned on the page linked in the question.
Encoder:
;;$^;s,.*,reverse+uc,e;
tr,+?.(),+~=<>,+rt;
1while+s/E/#_/s+s/T/`_/s+s! !{_!s+elihw1;
1while+s/A/`#_/s+s/N/#`_/s+s/I/##_/s+s/M/``_/s+elihw1;
1while+s/O/```_/s+s/D/##`_/s+s/R/#`#_/s+s/S/###_/s
      +s/G/#``_/s+s/U/`##_/s+s/W/``#_/s+s/K/`#`_/s+elihw1;
1while+s/B/###`_/s+s/C/#`#`_/s+s/P/#``#_/s+s/Q/`#``_/s
      +s/F/#`##_/s+s/H/####_/s+s/V/`###_/s+s/J/```#_/s
      +s/X/`##`_/s+s/L/##`#_/s+s/Y/``#`_/s+s/Z/##``_/s+elihw1;
1while+s/1/````#_/s+s/2/```##_/s+s/3/``###_/s+s!<!#``#`_!s
      +s/4/`####_/s+s/5/#####_/s+s/6/####`_/s+s/7/###``_/s
      +s/8/##```_/s+s/9/#````_/s+s/0/`````_/s+s!/!#`##`_!s+elihw1;
1while+s/~/##``##_/s+s/=/`#`#`#_/s+s/,/``##``_/s
      +s/:/###```_/s+s/'/#````#_/s+s/"/#`##`#_/s
      +s/-/`####`_/s+s!>!`#``#`_!s+elihw1;
tr,+{`#_,+/\-\. ,+rt;
;;$^;s,.*,reverse,e;
s/ //s

Decoder:
s// /s
;e,esrever,*.,s;^$;;
;tr+, .\-\/+,_#`{+,rt
;1while+s!_`#``#`!>!s+s/_`####`/-/s+
s/_#`##`#/"/s+s/_#````#/'/s+s/_```###/:/s+
s/_``##``/,/s+s/_#`#`#`/=/s+s/_##``##/~/s+elihw1
;1while+s!_`##`#!/!s+s/_`````/0/s+s/_````#/9/s+s/_```##/8/s+
s/_``###/7/s+s/_`####/6/s+s/_#####/5/s+s/_####`/4/s+
s!_`#``#!<!s+s/_###``/3/s+s/_##```/2/s+s/_#````/1/s+elihw1
;1while+s/_``##/Z/s+s/_`#``/Y/s+s/_#`##/L/s+s/_`##`/X/s+
s/_#```/J/s+s/_###`/V/s+s/_####/H/s+s/_##`#/F/s+
s/_``#`/Q/s+s/_#``#/P/s+s/_`#`#/C/s+s/_`###/B/s+elihw1
;1while+s/_`#`/K/s+s/_#``/W/s+s/_##`/U/s+s/_``#/G/s+
s/_###/S/s+s/_#`#/R/s+s/_`##/D/s+s/_```/O/s+elihw1
;1while+s/_``/M/s+s/_##/I/s+s/_`#/N/s+s/_#`/A/s+elihw1
;1while+s!_{! !s+s/_`/T/s+s/_#/E/s+elihw1
;tr+,><=~+,)(.?+,rt
;e,cu+esrever,*.,s;^$;;

Usage
$ perl -lp retr.pl <<<"(Morse) Code?"
-.--. -- --- .-. ... . -.--.- / -.-. --- -.. . ..--..
$ perl -p0e '$_=reverse' retr.pl >rter.pl
$ perl -lp rter.pl <<<"-.--. -- --- .-. ... . -.--.- / -.-. --- -.. . ..--.."
(MORSE) CODE?

Explanation:
;;$^;s,.*,reverse+uc,e; # parses as $^; s/.*/reverse uc/e
                        # and in decoder as e; cu + esrever; *.; s/^$//
                        # reverse and uppercase input, no-op in decoder
tr,+?.(),+~=<>,+rt;     # parses as tr/+?()/+=<>/ + rt
                        # in decoder as tr/,><=~/,)(.?/ , rt
                        # equivalent to y/?.()/~=<>/ and y/><=~/)(.?/ in decoder
1while+s/T/`_/s+elihw1; # parses as while(+s/T/`_/+elihw1){1}
                        #        => while(s/T/`_/s+0){}
                        # equivalent to s/T/`_/g and s/_`/T/g in decoder
s/ //s                  # remove leading space / add leading space

@Optimizer Obviously it can be easily expanded to support all characters that don't need escaping in a regexp. Just have to remember to start with shortest codes in the encoder, so decoder can work properly.

Could you add an explanation please?

@nutki I think you need to finish your program. The requirements say it needs to support the international morse code.

How can it decode the same '-.--.-' to '(' and ')'?

@edc65 Even occurrences are replaced with ( and odd with ). This works under the assumptions I stated.

@nutki I clarified this in the question

CJam, 286 bytes, no eval
Original (Morse encoder):
L;"'*S/as/'res]c:b46 056115970986603148,A>56,['[/,'c:+f34b4i%Ws;\;";q['[,65>A,841306689079511650 64b:c]s'";L
2750763932992480612976738964894343100372667569857057816704667471637641979761595859190213443543359288493237588430216583759463627409436875398907
L;"'/Sq;";\;4b43f+:c',/erS/'/*S*'";L

Reversed (Morse decoder):
L;"'*S*/'/Sre/,'c:+f34b4;\;";qS/'";L
7098935786349047263649573856120348857323948829533453443120919585951679791467361747664076187507589657662730013434984698376792160842992393670572
L;"'s]c:b46 056115970986603148,A>56,['[q;";\;sW%i4b43f+:c',/['[,65>A,841306689079511650 64b:c]ser'/sa/S*'";L

This is just a trivial tweak of Optimizer's solution to eliminate the string eval (~), in response to a meta post asserting that "[the] use of eval statements is what makes this abuse possible".  Accordingly, as it's mostly not my own code, I have marked it as Community Wiki.
Instead of Optimizer's trick of placing the eval operator ~ between two quoted strings, like this:
L;"encoder"~"reversed decoder";L

my version relies on the fact that, in CJam, any character following a single quote (') is interpreted as a character literal:
L;"'reversed decoder;";encoder'";L

Relevant CJam speed-tutorial: L is an empty string, "..." is a double-quoted string, '" is a literal double quote, and ; pops the most recent value off the stack.  Thus, this code first pushes an empty string, pops it, pushes the string 'reversed decoder;, pops it, executes encoder, pushes another double quote, pops it, and pushes an empty string (which has no effect on the output).
Update: Saved 8 bytes by a trivial (in hindsight) optimization.  With the further saving from eliminating needless backslashed, this is now just two bytes longer than Optimizer's original eval-based solution.

FYI, I have a 220 byte version ;)

@Deformyer: The thing is, even if you defined a comment loosely as "anything that allows easy unused code", I'm not sure what you'd ban to disallow the trick I describe above. Strings? Character literals? Popping elements off the stack? (Hint: The last one won't work; it's trivial to circumvent. In fact, I think I know a way to make this work without using any strings, either...)

@Deformyer: It's kind of hard to see what your criterion for "using a loophole" is, though, except maybe "doing anything that makes the challenge too easy", for some value of "too easy" primarily known to you. IMO, that makes the spec a moving target, or a "read my mind" challenge. In any case, my answer above doesn't "use any function that makes a string executable"; I believe I could even tweak it to not use any strings at all.

(The basic no-strings trick is something like L;{'redoced;};encoder'{;L, where the reversed decoder is wrapped in a code block that is parsed but never executed -- basically a CJam equivalent of if(0){...}. The main difficulty is that not all CJam code is syntactically valid when reversed, but it's not really a major hurdle, since most of it is.)


text:
Build a fewest-moves freecell solver
In the game of Freecell, you are tasked with building four foundation piles in suit from ace to king, on a layout where you build downward in alternating colours. However, you can only build one card at a time, so you are given four "free cells" each of which can contain one card to help you move entire sequences. The idea is that you weave individual cards in and out of the free cells as required to help you solve the game.
Your task is to build a program that will solve these games in the fewest moves possible.
Your program will take as input a sequence of 52 cards, in the following format:
2S 9H 10C 6H 4H 7S 2D QD KD QC 10S AC ...

Which will be dealt in the initial layout in this order:
01 02 03 04 05 06 07 08
09 10 11 12 13 14 15 16
17 18 19 20 21 22 23 24
25 26 27 28 29 30 31 32
33 34 35 36 37 38 39 40
41 42 43 44 45 46 47 48
49 50 51 52

And return a list of moves to solve the game. Each move will be in this format:

A number representing the pile number (1 through 8), or a free cell (A to D), representing the source pile.
Another number or letter representing the destination pile or free cell, or F for the foundation of that suit.

The output will look something like this:
18 28 3A 8B 8C 85 B5 35 4F etc.

Once a card is put into the foundation, it cannot be removed. Since only one card is moved at a time, moving a sequence of 3 cards requires 5 moves, and a sequence of 5 cards requires 9 moves.
If a game is unsolvable, your program should indicate as such. However, your program must be able to solve any solvable game.
Your program will be judged on the 32,768 deals found in the original Microsoft FreeCell program. In order to be valid, your program must successfully solve every deal except deal #11,982, which is unsolvable. Your score will be the total number of moves it takes to solve these 32,767 deals, with shorter code being a tie-breaker.

A file with all the decks in the format required by the above specification is available for download here (5.00 MB file): https://github.com/joezeng/pcg-se-files/raw/master/freecell_decks

Now I just need to nab the random number generator that they used to generate those 32,768 games. :S

The generator is here: http://rosettacode.org/wiki/Deal_cards_for_FreeCell

Thanks, nutki. Lemme generate a text file with the decks in them, for testing.

It would be nice if your example input sequence included at least one ace.

Oh, sorry, aces are A.

A quick question: Must the code handle the free cells as four separate "slots" or can the free cells be seen as a "stack" of max 4 cards? Codewise it would be unnecessary complicated to check which of the four slots is empty when that sub-problem can be reduced to wether any of the slots is free. Output-wise, the only changes would be that putting a card to the free cell would be i.e. "1C", "2C" instead of "1C1" or "1C2" or "1C3" or "1C4", the solution would still be valid.

That's a good point. How would you deal with the case in which, say, two cards of the same colour and number (such as 7C and 7S) are both in free cells? Then if you move from "C" to a black 8, it could be either of those two cards.

I think this problem has much larger hurdles than worrying about how to golf a few more bytes due to how the free cells are treated.  That could be done with a bit field showing whether a cell is occupied, or perhaps representing the free cells as a 4-byte string and searching for the first blank, or some other creative method.

1. @Lars Ebert: The free cells are no 4-card stack but four 1-card. 2. @Joe Z.: How about naming them A,B,C,D instead of C1..C4? I consider that easier to read.

@Titus That would work, actually.

You could possibly get some answers by removing the restriction that all solvable deals must be solved by the submission. Then, score based on number of deals solved, then by fewest moves.

Is Freecell a solved game, at least from all valid starting positions? If so, this is... well, not trivial, but fairly simple. If not, I'd rather not spend decades proving that it's the fewest possible moves.

Of interest: FreeCell solutions to 1000000 games

It's hard to understand from your description - how does that array relate to any of the piles?  Do the rows (or the columns) each represent a pile?  Or something else.  It's also very unclear what the valid moves are - I think it would help to show some examples (with "before" and "after" grids) showing representative valid and invalid moves.  It might help if you can link to a reference site, as it's probably not a very widely played variant.

Freecell is a solved game, thus it is known that there are unwinnable layouts.  E.g. seed 11982 on the Windows version.

can the cards be 0-Indexed?

Can the "10" card be represented by a T instead of a 10? That way, each individual card (AS, 2C) is two characters (TH) instead of sometimes three (10H).

@mbomb007 nah. Been there done this

Do we really need to solve every one? It took 2 days to solve the first ~700

Here´s a solution (including C source and a JavaScript port): http://fc-solve.shlomifish.org/. Idk if it´s really fewest moves, but it´s pretty good.

Haskell, Score: 4.98M, 7564 Bytes
{-# LANGUAGE BangPatterns #-}

import Control.Concurrent.Async (race)
import Control.Concurrent.Async.Extra (sequenceConcurrently)
import qualified Data.Vector as V
import qualified Data.List   as L
import qualified Data.IntSet as S

type Deck     = String           -- a line of the input, s.th. like
                                 -- JD 2D 9H JC 5D 7H 7C...
type Card     = (Int , Int)      -- (Suit, Rank)
type Cascade  = [Card]           -- bottom up, i.e. head is the accessible card
type Board    = V.Vector Cascade -- the whole Board: 16 lots of cascades
                                 -- 0..7:tableau, 8..11:cells, 12..15:foundation
type Move     = (Int , Int)      -- 'from' and 'to' board index
type Game     = (Board, [Move])  -- a Board and the Moves to get there
type Strategy = Int

idxTbl, idxFnd, idxTblR, idxFrom :: [Int]
idxTbl  = [ 0.. 7]               -- indices of tableau cascades
idxTblR = [7,6..0]               -- indices of tableau in reverse order
idxFnd  = [12..15]               -- indices of foundations
idxFrom = [ 0..11]               -- all indices where a card can be moved from

(@@) :: Board -> Int -> Cascade  -- return cascade at index i
(@@) = (V.!)

(@!) :: Board -> Int -> Int      -- return the rank of the top card at index i
brd @! i = snd $ head $ brd@@i

(//) :: Board -> [(Int, Cascade)] -> Board
(//) = (V.//)                    -- update from Data.Vector

solved :: Board -> Bool
solved brd = all ((==13).(brd@!)) idxFnd

--
--
--

main :: IO ()
main = print . sum =<< mapM solveDeck . lines =<< getContents

-- applies different strategies and hash functions to a given deck
-- does all the concurreny stuff
solveDeck :: Deck -> IO Int
solveDeck deck = do
  putStrLn $ "Playing Deck: " ++ deck

  mvs <- sequenceConcurrently            -- try fast hash funtions concurrently
         [dfs hsh S.empty s startGame | hsh<-[hashCLS, hashCL], s<-[1..4]]
  let scores = [(length m, reverse m) | m <- mvs, not $ null m]

  if null scores
  then do   -- unsolvable by fast hash functions, retry with slow hash function
    mvs2 <- race' (race' (dfs hashC S.empty 1 startGame)
                         (dfs hashC S.empty 4 startGame))
                  (race' (dfs hashC S.empty 2 startGame)
                         (dfs hashC S.empty 3 startGame))
    let score2 = length mvs2
    putStrLn $ "Solution: " ++ show (score2, reverse mvs2)
    return score2
  else do   -- at least one slow hash function succeeded, return best result
    let winner = minimum scores
    putStrLn $ "Solution: " ++ show winner
    return $ fst winner

  where
  !startGame = [(deal deck, [])]
  race' one two = race one two >>= either return return

-- depth first search with a given strategy and hash function
dfs :: (Board -> Int) -> S.IntSet -> Strategy -> [Game] -> IO [Move]
dfs _ _ _ [] = return []
dfs hashFn seen strat ((brd,mvs):games)
  | S.member hBrd seen = dfs hashFn seen strat games --skip board if seen before
  | solved brd = return mvs                          --solution found
  | otherwise = dfs hashFn (S.insert hBrd seen) strat (newGames++games)
                                                     --descend the search space
  where
  hBrd = hashFn brd
  newGames = nextGames mvs brd strat

-- one step in search
nextGames :: [Move] -> Board -> Strategy -> [Game]
nextGames moves brd strategy
  | mv:_ <- autoMoves = doAuto mv
  | otherwise         = checkMoves $ allMoves strategy

  where

  -- all possible from/to combinations except between freecells and only to
  -- first empty freecell. Based on strategy.
  allMoves 1 = [(f,t) | f<-fList, t<-tList idxTbl,  f<8||f>11||t<8||t>11]
  allMoves 2 = [(f,t) | f<-fList, t<-tList idxTblR, f<8||f>11||t<8||t>11]
  allMoves 3 = [(f,t) | t<-tList idxTbl, f<-fList,  f<8||f>11||t<8||t>11]
  allMoves 4 = [(f,t) | t<-tList idxTblR, f<-fList, f<8||f>11||t<8||t>11]
  allMoves _ = error "allMoves: strategy out of range"

  -- "from" indices are always ordered by minimum rank in respective cascade
  fList = L.sortOn (minimum.map snd.(brd@@)) $ filter (not.null.(brd@@)) idxFrom

  -- order of "to" indices is foundation before freecell before tableau
  -- * only tableau is subject to strategy
  -- * only first empty freecell (if any)
  -- * foundation is "12" for all suits, we'll unravel that later
  tList idxs
    | null $ brd@@ 8 = 12: 8:idxs
    | null $ brd@@ 9 = 12: 9:idxs
    | null $ brd@@10 = 12:10:idxs
    | null $ brd@@11 = 12:11:idxs
    | otherwise      = 12:   idxs

  -- checks which moves from 'allMoves' are actually legal and executes
  -- them returning a list of games
  checkMoves [] = []
  checkMoves (mv@(f,t):mvs)
    | t == 12   = if fitsFnd then doFnd else checkRest  -- to foundation
    | t  <  8   = if fitsTbl then doTbl else checkRest  -- to tableau
    | otherwise = doCell                                -- to cell (alway empty)

    where
    !cscdT = brd@@t
    !cscdF = brd@@f
    !cardF@(suitF,rankF) = head cscdF
    (suitT,rankT) = head cscdT

    fitsTbl = null cscdT || rankT==rankF+1 && odd (suitF+suitT)
    fitsFnd = rankF-1 == brd@!(12+suitF)

    doTbl  = (brd // [(t, cardF:cscdT),  (f, tail cscdF)], mv:moves) : checkRest
    doCell = (brd // [(t, [cardF]),      (f, tail cscdF)], mv:moves) : checkRest
    doFnd  = (brd // [(t+suitF, [cardF]),(f, tail cscdF)], (f,t+suitF):moves)
                                                                     : checkRest
    checkRest = checkMoves mvs

  -- a list of all greedy automoves
  autoMoves =
    [(f,12+s) | f <- idxFrom,                -- keep all 'from' indices
                let cascade = brd@@f,
                not $ null cascade,          -- if there's a card in the cascade
                let (s,r) = head cascade,
                r-1 == brd@!(12+s),          -- and it fits on its foundation
                let (j,k) = if even s then (13,15) else (12,14),
                r-4 <= min(brd@!j)(brd@!k) ] -- and it's not too greedy

  doAuto mv@(f,t)
    | fCrd:fCrds <- brd@@f = [(brd // [(t,[fCrd]),(f,fCrds)], mv:moves)]
    | otherwise            = error "nextGames: automove from empty cascade"

--
-- parsing and dealing decks
--

deal :: Deck -> Board
deal = foldl putCard emptyBoard . zip (cycle idxTbl) . parse

emptyBoard :: Board            -- foundation is initialised with dummy cards
emptyBoard =                   -- of rank 0, so that aces fit on them nicely
  foldl (\b i -> putCard b (i+12, (i,0))) (V.replicate 16 []) [0..3]

putCard :: Board -> (Int,Card) -> Board
putCard brd (i,crd) = brd // [(i, crd : brd@@i)]

parse :: Deck -> [Card]
parse [] = []
parse (' ':cs)       = parse cs
parse ('1':'0':s:cs) = (chrToSuit s , 10) : parse cs
parse (r:s:cs) | Just i <- L.elemIndex r " A23456789 JQK"
                     = (chrToSuit s, i) : parse cs
parse _              = error "parse: invalid deck"

chrToSuit :: Char -> Int       -- parity important: reds are even, blacks odd
chrToSuit c | Just i <- L.elemIndex c "DSHC" = i
chrToSuit _ = error "chrToSuit: invalid char"

--
-- hash functions
--

hashCLS, hashCL, hashC :: Board -> Int

hashCLS brd = foldl (\h r -> h*16+r)  c $ map (brd@!) idxFnd
  where c   = foldl (\h l -> h*32+l)  0 $ L.sort $ map (length.(brd@@)) idxTbl

hashCL  brd = foldl (\h r -> h*16+r)  c $ map (brd@!) idxFnd
  where c   = foldl (\h l -> h*32+l)  0 $          map (length.(brd@@)) idxTbl

hashC   brd = foldl (\h r -> h*16+r)  c $ map (brd@!) idxFnd
  where c   = foldl (\h s->h*26633+s) 0 $ L.sort $ map (hCscd.(brd@@)) idxTbl
        hCscd cList = foldl (\v (s,r) -> (v*26633+s)*94291+r) 0 cList

The list of games is read via stdin. For each game the output is a pair of the number of moves and a list of moves as (from,to) pairs, where both 'from' and 'to' are indices of board positions. 0 to 7 are the eight cascades, 8 to 11 the four free cells and 12 to 15 the four foundations. E.g.
Playing Deck: KS 8S 3C 9D QS 4D JD QH 5C 10H 5D 10C 4H 3D 7H AD KC 6S 2S 8D AH 7C QD 6C 7S KH 8C 6H 2C 9C JH KD 4S 5S AC 10S JS 3S 9S 5H AS 4C 8H QC 6D 2H JC 10D 7D 2D 3H 9H
Solution: (85,[(0,8),(0,13),(2,9),(2,10),(2,15),(4,11),(7,6),(2,3),(2,13),(9,0),(4,9),(4,15),(4,14),(5,14),(0,14),(4,14),(5,13),(0,13),(7,14),(5,6),(11,5),(1,11),(5,0),(1,2),(0,5),(1,13),(5,0),(8,3),(7,8),(7,3),(7,12),(11,12),(2,11),(2,3),(2,15),(11,15),(5,11),(5,12),(5,12),(3,12),(0,12),(0,5),(0,2),(0,15),(3,15),(3,12),(11,15),(3,15),(6,15),(1,11),(1,13),(5,13),(3,5),(9,7),(3,9),(6,7),(1,6),(1,13),(3,1),(3,14),(3,12),(3,15),(3,12),(7,12),(6,7),(6,15),(6,13),(1,13),(6,4),(6,3),(6,14),(6,12),(3,12),(8,12),(10,14),(5,14),(7,14),(4,14),(7,13),(4,13),(0,13),(7,14),(9,15),(2,15),(11,14)])

At the end the total number of moves is printed.
How it works: The basic approach is a depth first search. As the quality of the search (both number of moves and search time) heavily depends on the search order, I try several orders concurrently and pick the result that finishes first:

two different nested loops

for each available card look where it can be placed
for each position look if a card from elsewhere fits on it

when looping over the destination try in order

foundation before free cell before tableau from left to right
foundation before free cell before tableau from right to left

That's four different orders (or strategies as I call them) in combination. Source order is the same for all strategies: sorted by minimum rank of all cards in the respective cascade/freecell. There's also autoplay, i.e. if a card can safely be placed in the foundation it's the only move in this situation. It turns out that a greedy autoplay leads to slightly better results, so I autoplay up to two additional ranks (e.g. autoplay 8s even if 5s of opposite color are still around).
However, all this is not good enough (5 games do not finish within reasonable time; about 14.7M moves for the rest), but I had a lucky find: somehow you have to keep track of the boards visited so far to prevent infinite loops during the search. The above method uses a hash which is calculated by rolling through the cascades and including suit and rank of all the cards along the way. Now we are just hashing the length of each cascade plus the top foundation cards (i.e. two boards result in the same hash if (and only if) the foundations are equal and all cascades in order have pairwise the same length). Yes, we do get a lot of collisions but they restrict the search space at pretty good spots and lead to far fewer moves in far less time. In fact, the search is so fast that we can afford to finish all four strategies and pick the best result. A similar hash function where for collision the matching length of a cascade can be anywhere in the tableau and not necessarily at the same index produces even better results - at least on average. Now we can try 8 variants (2 fast hash function with 4 strategies each) and pick the best result. Note: not all variants can solve every game but just one success is enough to get a result. There are 11 games (including the unsolvable #11982) which none of the variants can solve. In these cases I switch back to the slow hash function and pick the fastest result.
Using 4 cores on my laptop this solves all games in about 1.5h and a total of 4.98M moves.
Remarks

The total number of moves can vary by a few hundred, because the result of the games with the slow hash function depends on how the OS assigns CPU time to the strategies and in different a run a different strategy might finish first. But that's just for 10 games.
If I let all 12 variants (3 hash functions with 4 strategies each) race agains each other and pick the fastest result I get 7.25M moves in 250 sec.
The source code is not golfed at all. Removing unnecessary things like comments, types, type annotations, whitespace, error handling and switching to single letter names easily brings the byte count to a third and then we can still apply the usual golfing tricks.

C 64,643 bytes, Score: ~6.5 million
The following Stack Snippet (courtesy of Mego) outputs all of the code as a single standalone C file:

$("#a").text(pako.inflate(atob('[encoded data, 7512 characters]'), {to: 'string'}));
<script src="https://cdn.rawgit.com/nodeca/pako/master/dist/pako.min.js"></script>
<script src="https://ajax.googleapis.com/ajax/libs/jquery/2.1.1/jquery.min.js"></script>
<pre id="a">

</pre>

Download the original source here.
Use GCC and run make then using the guideline in the readme.
My formatting is bad (all the different files are in one code block) and this could be golfed more (12k bytes tho). Any help would be loved!
Some of the code is not mine. I used it from a un-copyrighted source. I however fixed the input/output method to be within the challenge (a long task since I am horrible at C (5ish hours)). I also had to re-write much of the code and debug everything. Many thanks to my Dad for helping out and being a rubber duck (and pointing out my memory management errors) and for everyone on TNB who dealt with my angry rants about segfaults and C.

You may be able to use this to get around the answer length restriction and have all of your code within the answer, rather than needing an external download.

@Mego i mean yeah but it is in several files

It's easy to combine multiple C files into a single one.

Here is a stack snippet that shows the code combined into a single file.

@mego can you edit that in? On mobile


text:
Convert RGB integer value into RGB values
For example, in traditional web hexadecimal, a certain base-16 number represents an RGB value. For example, 45A19C equals (69,161,156) in RGB.
You'll be converting from that number to RGB value, however, instead you'll be given that number in base-10 rather than base 16.
So in the example used above, 45A19C would equal 4563356 in base-10. Thus 4563356 converted to RGB would equal (69,161,156).
So assume the integer given is previously stored in variable n and is between 0 and 16777215. Take number n and convert it to RGB values between 0 and 255. Return or save in a variable the three values as a list [r,g,b].
An RGB to RGB int can be found here. This link converts the opposite of what your trying to do.
Shortest code wins.
If clarification is needed, please ask so I can fix my question to be more helpful.

Full program, function, or code snippet?

@TheBestOne The question explicitly says we can assume the input to be stored in a variable n, so I think that implies snippet.

The question says "return or save in a variable". Are expressions acceptable or is a return statement required for the former?

The question asks for the three values "as a list" - most of the answers posted I would say return the values as an array, not a list.  If an array is permitted then the winning answer has no length at all in most assembly languages.

@SideshowBob Presumably only if you 'run' it on a big-endian machine?

Good point, the machine would have to be big endian

I'm really concerned about inclarity in the I/O rules here. Given that in many languages, a 24-bit variable would naturally be stored as a list of three bytes, how can we distinguish what counts as input and output?

AVR ABI, 0
Quantities larger than the registers in the AVR's registers are represented with multiple registers. So, when passing in a 32-bit 'n' to a function, it is passed as 4x8-bit registers. Effectively R(r24),G(r23), and B(r22) are directly addressable without any additional work by virtue of the CPU's register addressing.
Here's some 'C' code for the unpacking operation:
unsigned char r( unsigned long n ){return n>>16&255;}
unsigned char g( unsigned long n ){return n>>8&255;}
unsigned char b( unsigned long n ){return n>>0&255;}

disassembled examples from avr-gcc 4.8:
.global r
.type   r, @function
r:
ret
.size   r, .-r

.global g
.type   g, @function
g:
mov r24,r23
ret
.size   g, .-g

.global b
.type   b, @function
b:
mov r24,r22
ret
.size   b, .-b

For red, GCC just emits the return code since the red byte just happens to be in the return register already. For green and blue it copies the corresponding register into the return register and returns. The actual packing/unpacking is handled by the ABI - when done somewhere other than a function call boundary, it's handled purely by the register addressing. Both the copies and return opcode are overhead required to view this happening in the CPU - the compiler can use these registers directly if not required to place the result in the return register. Free RGB packing/unpacking is available when handing any 32-bit integer.
Another way to think about it is that the AVR's registers represent large numbers as a list of 8-bit registers, and that list happens to unpack RGB for us.

Java 35 31 bytes.
Yay!!! A java answer under 40 bytes.
new int[]{n>>16,n>>8&255,n&255}

Interestingly, java integers are always stored as Binary numbers.
Consequently this snippet returns [69,161,156] whether n = 0x45A19C, 4563356, or 0b10001011010000110011100.

Well, any language that doesn't intentionally use some nonstandard representation will store integers in binary -- after all, that's what every modern processor (that I know of) uses.

As the max value is 16777215, you don't need the first binary and

@edc65 it still assures correct sign

" n and is between 0 and 16777215" what sign?

CJam, 11 bytes
NG6#+256b1>

This assumes that the base-10 integer is stored in N (there are no lower-case variable names), and it leaves the required list on the stack. This simply gets the digits in base 256. To take care of leading zeroes, we first add 2563 = 166. This will always give us 4 digits, the first one being 1, so at the end we slice off that extraneous digit with 1>:
N           "Push N.";
 G6#        "16^6.";
    +       "Add.";
     256b   "Get base-256 digits.";
         1> "Slice off leading digit.";

Test it here. You can use the following framework to initialise N and view the stack afterwards:
4563356:N;
NG6#+256b1>
ed

Of course, if I'm allowed to just have the input on the stack, instead of storing it in N, the solution is only 10 bytes, G6#+256b1>.

Should the list contain fewer than three values for N<65536?

Tested, fail with number smaller than 65536

@ngn Good catch, fixed.

Ostrich 0.5.0, 13 bytes
n16 6?+256B1>

Might as well post this just to promote Ostrich, even though it's essentially the same as @MartinBüttner's. (The only thing I changed was b -> B, since all built-in functions are either symbols or capital letters in Ostrich, and G -> 16  since Ostrich doesn't have that fancy built-in number (which it really should).)
Idential translation to Golfscript (18 bytes):
n 16 6?+256base 1>

So how does ostrich differ from cjam?   Something must make it special but the contents of the doc directory don't really help.

This fails on numbers less than 65536

@Optimizer Good catch; fixed.

Mathematica, 22 bytes
IntegerDigits[n,256,3]

Basically the same as my CJam answer. But I don't know a lot of languages that handle base conversion with arbitrary bases, so I thought I'd post both versions.
This one handles leading zeroes by using IntegerDigits' third parameter which pads the result to specified number of digits.

APL, 8 characters
n⊤⍨3⍴256
3⍴256  is 256 256 256
B⊤⍨A   is A⊤B
A⊤B    encodes B in a number system specified by A
         It doesn't have to use a uniform radix, e.g.:
         365 24 60 60 1000 ⊤ time

C/C++, 31
int r=n>>16,g=n>>8&255,b=n&255;

Convergently evolved to TheBestOne's answer, with the same size.
C/C++, 31
int c[]={n>>16,n>>8&255,n&255};

This one actually makes a list(array). I'm not sure if it would count without "int c[]=". If so, it would be 23 bytes
Also added Uri Zarfaty's optimization to not mask the red channel, as by this point blue and green are already shifted away.

Ruby, 25
[16,8,0].map{|x|n>>x&255}

The javascript answer by @Oriol is valid ruby as well, but at least this uses ruby features... (and it's a byte shorter).

Rebol - 43 40
x: to-tuple to-hex n reduce[x/6 x/7 x/8]

Example:
>> n: 4563356
== 4563356

>> x: to-tuple to-hex n reduce [x/6 x/7 x/8]
== [69 161 156]

Alternative 40 char solution:
map-each x[-16 -8 0][(shift n x)and 255]

J (10)
(3#256)#:]

Demonstration:
    f=:(3#256)#:]
    f 4563356
69 161 156
    f 12
0 0 12

JavaScript, 26 22
[n>>16,n>>8&255,n&255]

Inspired by TheBestOne's answer. I don't know bitwise operators very much, but it seems to work.

As the max value is 16777215, you don't need the first binary and [n>>16,n>>8&255,n&255]

Python, 28 bytes
The final value is stored in c
c=[n>>16&255,n>>8&255,n&255]

ARM Assembly, 45
UXTB r1, r0, 16
UXTB r2, r0, 8
UXTB r3, r0, 0

Assuming N is passed in to R0, R1 contains Red, R2 contains Blue, and R3 contains Green. The result list is stored in r1,r2,r3.
Assembles to 12B of ARM instructions or 6B of 16-bit Thumb instructions.

Erlang, 25 Bytes
binary_to_list(<<N:24>>).

Using the bit syntax, extracts 24 bits from N, which results in a binary of size 3.

Python 3, 23 bytes
*c,=n.to_bytes(3,'big')

If bare expressions are allowed then the following is one byte shorter:
[n>>16,n>>8&255,n&255]

Ruby, 44
Not a winner, but this makes use of Ruby's (very useful) optional parameters to String#to_i and Integer#to_s. They both take a base.
f=->i{i.to_s(16).scan(/../){|x|p x.to_i 16}}

C - 56 characters, but no calculations required
C doesn't really have lists, but would just like to point out that if you know the architecture (and there are macros to do this for you) you can retrieve RGB with no calculation, just defining types.
Something like this:
enum {B, G, R};
typedef union {int i; unsigned char u[3];}T;

Then you access like this:
#include <stdio.h>

int main(void)
{
    T t;

    // Set the color
    t.i = 0x45A19C;

    // Pull out the primaries
    printf("%u %u %u\n", t.u[R], t.u[G], t.u[B]);

    return 0;
}

There are some portability problems with this approach: int can be as small as 16 bits, endianness would require reordering the enum and possibly adding a dummy before the first color.

It's hardly "free", except in AVR or other 8-bit machines.  If your value is in memory, it takes three loads to get the bytes into 3 separate registers.  Or if it's in a register, the compiler will emit shift/mask instructions when you type-pun it.

This would be a better answer if you gave a specific platform it worked on.  For example, big-endian MIPS32.  See also https://en.wikipedia.org/wiki/RGBA_color_space#Representation

dc, 10
dc is a stack-based language so I'm assuming input and output on the stack is OK:
256~r256~r


text:
Code a Code Slidey Puzzle!
The most recognizable sliding puzzle is the fifteen puzzle. It has a 4 by 4 grid, 15 tiles, and one empty grid space. The tiles can only move into the empty space and must always be in line with the grid.
Let's define a generalized sliding puzzle as a two-dimensional W wide by H high grid (W, H both positive integers) that contains some number of identical unmarked tiles (between 0 and W×H of them) snapped to the grid, arranged in any way (without overlapping), with empty grid spaces filling the rest of the area.
For example if W and H are 3 and a tile is T and an empty space is E one of many possible siding puzzle arrangements is
TTT
TET
EET

For these puzzles there are 4 possible moves: shove everything up, shove everything down, shove everything left, or shove everything right. 'Shoving' in some direction makes all the tiles travel in that direction as far as possible until they hit another tile or the grid boundary. Sometimes shoving will not change the layout of the grid,
If the example grid is shoved right the result is
TTT
ETT
EET

Shoved left the result is
TTT
TTE
TEE

Shoved down the result is
EET
TET
TTT

(notice that both the leftmost T's moved)
Shoving up does not change the grid layout in this case.
Note that since the tiles are indistinguishable these puzzles do not have 'solved' states. Also note that a puzzle may start in a layout that is impossible to get back to once a shove has been made (e.g. one tile in the middle of a 3 by 3 grid).
Challenge
Using only printable ASCII write two rectangular blocks of code, both M characters wide and N characters tall (for any positive integers M, N). One code block will represent a tile of a sliding puzzle, the other code block will represent an empty grid space.
Arranging these two code blocks into a W by H grid will create a code-represented sliding puzzle which can be saved as a text file and run as a normal program. When run, these kind of programs should prompt the user via stdin for a number from 1 to 4; 1 is for up, 2 down, 3 left, 4 right. When the user types in their number and hits enter, the program calculates how to shove its source code tiles in that direction and saves the new puzzle layout in a file (either a new file or in the same file), then terminates.
This process can be repeated indefinitely with the new sliding puzzle code file generated after each shove.
Example
Suppose my tile code block looks like this
//   my
// tile

and my empty grid space code block looks like this
//empty
//space

(M = 7, N = 2, this is of course not actual code)
Any valid sliding puzzle arrangement of these two blocks should create a program in the language I'm using that can be run to let the user shove in some direction.
The code representation of the example grid is:
//   my//   my//   my
// tile// tile// tile
//   my//empty//   my
// tile//space// tile
//empty//empty//   my
//space//space// tile

So running this and pressing 2 (for down) then Enter would write this to another file (or the same file):
//empty//empty//   my
//space//space// tile
//   my//empty//   my
// tile//space// tile
//   my//   my//   my
// tile// tile// tile

That file could then be run and shoved in the same exact way.
Notes

Any code-representation of a W by H sliding puzzle should be runnable and be able to shove itself properly. This includes all grid sizes from 1 by 1 to some reasonable maximum (216 by 216 or more).

A program may read its own source code. There are no quine-based restrictions. Comments of any sort are also fine.

The program must prompt for a direction to shove in even if there are no tiles to shove or no tiles can be shoved. The prompt is simply a place to type in a number, no message is required.

You may assume the input is always valid (1, 2, 3, or 4).

Padding your code blocks with spaces is fine. Remember that they can only be printable ASCII, this mean no tabs and no newlines (besides the newlines that help form the code blocks).

If your language does not support stdin use whatever input method seems closest.

You can require that a newline be at the end of your code-puzzle files. (Or require that it not be there.)

How you name new files is not important. f.txt or just f is fine.

The two code blocks may not be identical.

Scoring
The goal is to do this with the smallest code size (which is why this is tagged code-golf). The submission with the smallest code block area (M×N) is the winner. Tie-breaker goes to the highest voted answer.
Related: Code that runs the Game of Life on itself

So the program needs to work when there are only empty spaces and no tile blocks (and vice versa)?

@grc Yes to your first question, and remember it still needs to prompt for a shove value even if totally empty or full. No the blocks can't be identical. I guess if they were you could claim to have a fairly trivial answer. So I'll mention that.

Can I specify the name of the original source file?

@feersum Like can you assume it is always f.txt? Yes.

Aren't codeblocks always going to be 1 line? Multi-line codeblocks seem really complex to me and 2D esolanguages probably don't have support for writing files.

@Deformyer Multi-line blocks can help in figuring out how wide the grid is.

You ask us to code a puzzle... with that puzzle's own code. What's next, Tetris written in it's own code?

TECO, 153
Empty block:
0T@^Ux#EBx#27@:^Ux##MxA1^QUq^T%d/51%w"G153UsZ/QqUlQq/153Un|Qq%s/153UlZ/QqUn'Qd&1UhQl<.UpQn<Qh-\"F%c'TRQs:C>QpJQn<D-%c"L%c1-Qh\|Qh\'RQs:C>Qw"GC|153%pJ'>EX

Tile block:
1T@^Ux#EBx#27@:^Ux##MxA1^QUq^T%d/51%w"G153UsZ/QqUlQq/153Un|Qq%s/153UlZ/QqUn'Qd&1UhQl<.UpQn<Qh-\"F%c'TRQs:C>QpJQn<D-%c"L%c1-Qh\|Qh\'RQs:C>Qw"GC|153%pJ'>EX

The program, which modifies itself in place, must be saved in a file named x. It can be run via the command tecoc mung x.. The dot is important; without it, TECO attempted to find a file named x.tec. The trailing newline must be present.
The printable ASCII restriction was a bit of a pain for this one, as the language utilizes many unprintable characters. Most of them can be replaced by a two-byte sequence beginning with a caret, but "Escape" (ASCII 27) is the one character that is 'inescapable', so to get it I had to put its ASCII value into a string and exec it. Thus, the 4-byte EBx<Esc> exploded into @^Ux#EBx#27@:^UX##Mx.
This could be reduced greatly, especially by splitting the program into two parts, storing them as strings and running only if both are present.


text:
Compute the Join and Meet of Partitions
Background
In this challenge, a partition of a set S means a collection of nonempty subsets of S, which are mutually disjoint and whose union is S. We say that a partition p is finer than another partition q (and q is coarser than p), if it can be obtained from q by splitting some of its sets into smaller pieces. The join (or least upper bound) of two partitions is the finest partition which is coarser than both of them, and their meet (or greatest lower bound) is the coarsest partition which is finer than both of them. See the Wikipedia pages on partitions and lattices for more information and nice pictures.
One way to compute the join and meet of two partitions p and q is the following. Form a graph whose vertex set is S, and add an edge a - b for each pair a, b that are in the same set in either p or q. Then the join of p and q contains the connected components of this graph. The meet of p and q consists of all nonempty intersections of a set in p with a set in q.
For example, consider the partitions [[0,1],[2,3]] and [[0,1,2],[3]] of S = [0,1,2,3]. The graph mentioned above is
0-1
|/
2-3

where the edge 2 - 3 comes from the first partition (2 and 3 are in the same set), and the triangle comes from the second one (0, 1 and 2 are in the same set). This means that the join is [[0,1,2,3]]. The intersections of all the sets in the partitions are
[0,1] ∩ [0,1,2] = [0,1],
[0,1] ∩ [3]     = [],
[2,3] ∩ [0,1,2] = [2],
[2,3] ∩ [3]     = [3]

Removing the empty set, we have the meet [[0,1],[2],[3]].
Input
Two partitions of a finite set of integers, given as arrays of arrays.
Output
The join and meet of the input partitions, in this order.
Test Cases
[[1]] [[1]] -> [[1]] [[1]]
[[0,1],[2,3]] [[0,1,2],[3]] -> [[0,1,2,3]] [[0,1],[2],[3]]
[[0],[1],[2,3,4,7,6]] [[2,3],[4,7],[6],[1,0]] -> [[0,1],[2,3,4,6,7]] [[0],[1],[2,3],[4,7],[6]]
[[0],[1,2],[5,4],[3,6]] [[0,3],[6,4],[5,2],[1]] -> [[0,1,2,3,4,5,6]] [[0],[2],[1],[4],[5],[3],[6]]

Detailed Rules
The order of the sets in the output partitions, and of the numbers in those sets, does not matter. You can assume that the inputs are correct, that is, they contain the same numbers, each exactly once, and no empty arrays. Note that the numbers do not necessarily form an interval (the third test case contains no 5).
You can write either a full program or a function. You can also write two programs/functions in the same language, one of which computes the join and other the meet, but there's a bonus of -10 bytes if you don't choose this option. The shortest byte count wins, and standard loopholes are disallowed.

May one provide two functions?

@xnor No, you must do it in one function. If you provide two functions, you also need to provide a third one that combines their outputs (wrapping them in a list or tuple or such).

@xnor On a second thought, I think I'll allow two functions, but give a bonus if you can do it in one. I'll edit the question.

In the 4th example, the join is not the finest partition. A finest partition would consist of a set of 3, 2, 2 numbers each. Same for the meet.

@Optimizer I don't see how that's possible. Do you have an example output?

@Optimizer You can think of the operations like this. If two numbers are in the same set in either of the inputs, then they must be in the same set in the join. And if two numbers are in different sets in either input, then they must be in different sets in the meet.

It's quite hard to find the "more info" in the Wikipedia article you link. It contains the word meet zero times, and the word join once, in the context of non-crossing partitions. It might be helpful to link first to a page about lattices or complete lattices, and then to the section of the page on partitions of a set which talks about the lattice structure of the refinement partial order.

@PeterTaylor You're right, and now that I tried, I actually couldn't find anything on how to actually compute the join and meet (without resorting to a Google Books preview). I added some explanation about this. I hope it is clear enough.

CJam, 32 - 10 = 22
q_~{_{T&},:U-U:+a+}fTp~m*::&La-p

::& is newer than this question.
CJam, 36 - 10 = 26
q_~{:T;_{T&},:U-U:+a+}/p~m*{~&}%La-p

Input:
[[0] [1] [2 3 4 7 6]]
[[2 3] [4 7] [6] [1 0]]

Output:
[[2 3 4 7 6] [0 1]]
[[0] [1] [2 3] [4 7] [6]]

Explanation
q                 " Read the input. ";
_~                " Evaluate a copy. ";
{:T;              " For each list T in the second partition: ";
    _{T&},        " Select all lists in the first partition which share items with T. ";
    :U-           " Save to U and remove them from the first partition. ";
    U:+a+         " Append the union of U to the first partition. ";
}/
p                 " Print the meet. ";
~                 " Evaluate another copy. ";
m*                " Get the Cartesian product. ";
{~&}%             " Get the intersections of each pair of lists. ";
La-               " Remove empty lists. ";
p                 " Print. ";

That is impressively short.

Java: 2014 (-10) = 2004 bytes
import java.util.*;public class A{static List<List<Set<Integer>>>b(Integer[][]c,Integer[][]d){Integer[][]e;Integer[][]f;if(c.length<=d.length){e=c;f=d;}else{e=d;f=c;}
Q g=h(e);List<List<Set<Integer>>>i=new ArrayList<>();i.add(j(f,g));i.add(k(f,g));System.out.println(i.toString());return i;}
static List<Set<Integer>>j(Integer[][]l,Q m){for(Integer[]o:l){if(o.length>1){n(m,o);}}
return p(m);}
static List<Set<Integer>>k(Integer[][]q,Q r){List<Set<Integer>>s=new ArrayList<>();for(Integer[]t:q){for(Set<Integer>u:v(r,t).values()){s.add(u);}}
return s;}
static Map<R,Set<Integer>>v(Q w,Integer[]x){Map<R,Set<Integer>>y=new HashMap<>();for(Integer z:x){R a=w.getSubset(z);if(!y.containsKey(a)){y.put(a,new HashSet<>());}
y.get(a).add(z);}
return y;}
static List<Set<Integer>>p(Q partition){partition.b();List<Set<Integer>>c=new ArrayList<>();for(R d:partition.y){Set<Integer>e=new HashSet<>();R f=d;while(f!=null&&!f.g){e.addAll(f.t);f.g=true;f=f.s;}
if(!e.isEmpty()){c.add(e);}}
return c;}
static void n(Q h,Integer[]i){for(int j:i){R k=h.getSubset(j);for(int l:i){R m=h.getSubset(l);if(k.s==null&&k!=m&&k!=m.s){k.s=m;}}}}
static Q h(Integer[][]n){List<R>o=new ArrayList<>();for(Integer[]p:n){o.add(new R(p));}
return new Q(o);}}
class R{R s;Set<Integer>t;boolean g=false;R(Integer[]u){this.t=Collections.unmodifiableSet(new HashSet<>(Arrays.asList(u)));}
R(Set<Integer>v){this.t=Collections.unmodifiableSet(v);}@Override
public int hashCode(){final int p=31;int r=1;r=p*r+((t==null)?0:t.hashCode());return r;}@Override
public boolean equals(Object x){if(this==x)
return true;if(x==null)
return false;if(getClass()!=x.getClass())
return false;R other=(R)x;if(t==null){if(other.t!=null)
return false;}else if(!t.equals(other.t))
return false;return true;}}
class Q{List<R>y;R getSubset(Integer z){for(R a:y){if(a.t.contains(z)){return a;}}
return null;}
Q(List<R>b){this.y=b;}
void b(){List<R>c=new ArrayList<>();for(int i=0;i<y.size();i++){if(y.get(i).s!=null){c.add(y.get(i));y.remove(i);}}
c.addAll(y);this.y=c;}}

Run by calling the b() function with two Integer[][].
Using the given inputs, outputs are:
[[[1]], [[1]]]
[[[0, 1, 2, 3]], [[0, 1], [2], [3]]]
[[[0, 1], [2, 3, 4, 6, 7]], [[2, 3], [4, 7], [6], [1], [0]]]
[[[0, 1, 2, 3, 4, 5, 6]], [[3], [0], [6], [4], [2], [5], [1]]]

and a downvote is because ?

It might be worth dropping in to [chat] to ask about what can be improved and get a feel for the site. I find it very helpful for myself.

@Nhan — I don't know why you were downvoted either. I just voted your answer up.

Mathematica, 127 - 10 = 117
Not fully golfed.
{ConnectedComponents@Graph@Union@##,FindClique[Graph@Intersection@##,Infinity,All]}&@@(Union@@(Rule@@@Tuples[#,2]&/@#)&/@{##})&