-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathLittlewoodRichardson.mac
110 lines (103 loc) · 5.95 KB
/
LittlewoodRichardson.mac
1
2
3
4
5
6
7
8
9
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
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
/* Copyright (C) 2013 by Alessandro Campagni */
/*
* This file is part of YoungTableaux.
* YoungTableau is free software: you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation, either version 3 of the License, or
* (at your option) any later version.
*
* YoungTableaux is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with YoungTableaux. If not, see <http://www.gnu.org/licenses/>.
*
*
* Author: Alessandro Campagni <[email protected]>
*/
/* We should check that the three diagrams are suitable for Littlewood Richardson */
/* rev_big_shape, rev_small_shape are reversed words of diagrams */
/* gen_skew_tab should be [], and curr should be 1 */
generic_skew_tableau (rev_big_shape, rev_small_shape, gen_skew_tab, curr) := block (
[],
if curr <= length (rev_small_shape) then block (
[empty_box,zeros,infs,current_line],
empty_box : rev_small_shape[curr],
zeros : makelist (0, empty_box),
infs : makelist (inf, rev_big_shape[curr] - empty_box),
current_line : [append (zeros, infs)],
return (generic_skew_tableau (rev_big_shape, rev_small_shape, append (current_line, gen_skew_tab), curr + 1)))
else if curr <= length (rev_big_shape) then block (
[current_line],
current_line : [makelist (inf, rev_big_shape[curr])],
return (generic_skew_tableau (rev_big_shape, rev_small_shape, append (current_line, gen_skew_tab), curr + 1)))
else return (gen_skew_tab));
/* Remark: in filling a transposed Littlewood-Richardson skew tableau, beginning from bottom left */
/* we must start with 1 (otherwise the corresponding word is not a lattice word, and hence the corresponding */
/* word of the skew tableau is not a reverse lattice word). For preserving the structure of the tableau */
/* the first column should be filled with ones. */
/* A proof of this remark is in my thesis (http://linkgoeshere). */
/* st should be a transposed generic skew tableau, fst should be [] and level should be 1. */
fill_first_line (st, u) := block (
[filled_skew_tableau, ones],
filled_skew_tableau : copylist (st),
ones : lsum (i, i, map (lambda ([x], x[1] : x[1]/inf), filled_skew_tableau)),
/* we should check if there are enough ones in the content u to fill the first column! */
if ones <= u[1] then return ([filled_skew_tableau, ones]) else return ([]));
reverse_lattice_word_condition (u, u_ins, try) :=
if (try > 1) and (u[try] > u_ins[try]) and (u_ins[try] + 1 <= u_ins [try-1]) then true
else if (try = 1) and (u[1] > u_ins[1]) then true
else false;
/* u_len should be length (u) */
young_tableau_condition (curr, u_len, i, j, try) :=
if ((i>1) and (length(curr[i-1])>=j) and (try<=curr[i-1][j])) or ((i>1) and (length(curr[i-1])<j)) or (i=1) then block (
if (j>1) and (i<length(curr)) and (curr[i][j-1]<try) and (try<=u_len-length(curr[i])+j) then true
else if (j=1) and (i<length(curr)) and (try<u_len-length(curr[i])+j) then true
else if (j>1) and (i=length(curr)) and (curr[i][j-1]<try) and (try<=u_len-length(curr[i])+j) then true
else false)
else false;
/* try should be 1 */
/* nextl should be [] */
/* curr[i][j] is empty, we should check this before calling next_element */
next_element (curr, u, u_ins, i, j, try, nextl) :=
if (try <= length (u)) then block (
[],
if reverse_lattice_word_condition (u, u_ins, try) and young_tableau_condition (curr, length (u), i, j, try) then block (
[nexte, next_u_ins],
nexte : copylist (curr),
next_u_ins : copylist (u_ins),
nexte[i][j] : try,
next_u_ins[try] : next_u_ins[try] + 1,
return (next_element (curr, u, u_ins, i, j, try + 1, append (nextl, [[nexte, next_u_ins]]))))
else return (next_element (curr, u, u_ins, i, j, try + 1, nextl)))
else return (nextl);
/* Returns a list containing the list of Littlewood-Richardson skew tableaux */
/* with a given shape d\e and a given content u (i.e. Littlewood-Richardson number) */
/* Actually d,e,u will be reversed words of transposed tableaux */
/* d,e are reversed words of diagram, */
/* u is a reversed words of a diagram with u[1]-(second (generic_skew_tableau (d, e, [], 1), [])) */
/* u_ins keeps track of which and how many letters have been used, should be makelist (0, length (u)) */
/* st should be the transposed generic skew tableau with first line filled with ones */
/* i.e. fill_first_line (remove_tableau_column (first (generic_skew_tableau (d, e, [], 1), []))) */
/* tl is the tableaux list, should be [[st, u_ins]] */
/* i,j are index to move around the skew tableau like in a matrix, i sould be 1 and j 2 */
/* This function should be called only if fill_first_line returns non empty list. */
littlewood_richardson_num (d, e, u, tl, i, j) := block (
[],
/* WARNING! do not change the order in the if condition! */
if (not emptyp (tl)) and (i <= length (tl[1][1]))then block (
[curr],
curr : first (tl), /* curr[1] is a skew tableau, curr[2] is the crresponding u_ins */
if (j <= length (curr[1][i])) then block (
[],
if (curr[1][i][j] # inf) then return (littlewood_richardson_num (d, e, u, tl, i, j+1))
else block (
[next_l],
tl : delete (curr, tl),
next_l : next_element (curr[1], u, curr[2], i, j, 1, []),
tl : append (tl, next_l),
return (littlewood_richardson_num (d, e, u, tl, i, j))))
else return (littlewood_richardson_num (d, e, u, tl, i+1, 1))) /* end of line, go to next */
else return (tl));