1 /* j/5/loss.c
2 **
3 */
4 #include "all.h"
5 
6 
7 /* functions
8 */
9   typedef struct _u3_loss {                 //  loss problem
10     u3_noun hel;                            //  a as a list
11     c3_w lel_w;                             //  length of a
12     c3_w lev_w;                             //  length of b
13     u3_noun* hev;                           //  b as an array
14     u3_noun sev;                            //  b as a set of lists
15     c3_w kct_w;                             //  candidate count
16     u3_noun* kad;                           //  candidate array
17   } u3_loss;
18 
19   //  free loss object
20   //
21   static void
_flem(u3_loss * loc_u)22   _flem(u3_loss* loc_u)
23   {
24     u3z(loc_u->sev);
25     {
26       c3_w i_w;
27 
28       for ( i_w = 0; i_w < loc_u->kct_w; i_w++ ) {
29         u3z(loc_u->kad[i_w]);
30       }
31     }
32     free(loc_u->hev);
33     free(loc_u->kad);
34   }
35 
36   //  extract lcs  -  XX don't use the stack like this
37   //
38   static u3_noun
_lext(u3_loss * loc_u,u3_noun kad)39   _lext(u3_loss* loc_u,
40         u3_noun  kad)
41   {
42     if ( u3_nul == kad ) {
43       return u3_nul;
44     } else {
45       return u3nc(u3k(loc_u->hev[u3r_word(0, u3h(kad))]),
46                   _lext(loc_u, u3t(kad)));
47     }
48   }
49 
50   //  extract lcs
51   //
52   static u3_noun
_lexs(u3_loss * loc_u)53   _lexs(u3_loss* loc_u)
54   {
55     if ( 0 == loc_u->kct_w ) {
56       return u3_nul;
57     } else return u3kb_flop(_lext(loc_u, loc_u->kad[loc_u->kct_w - 1]));
58   }
59 
60   //  initialize loss object
61   //
62   static void
_lemp(u3_loss * loc_u,u3_noun hel,u3_noun hev)63   _lemp(u3_loss* loc_u,
64         u3_noun  hel,
65         u3_noun  hev)
66   {
67     loc_u->hel = hel;
68     loc_u->lel_w = u3kb_lent(u3k(hel));
69 
70     //  Read hev into array.
71     {
72       c3_w i_w;
73 
74       loc_u->hev = c3_malloc(u3kb_lent(u3k(hev)) * sizeof(u3_noun));
75 
76       for ( i_w = 0; u3_nul != hev; i_w++ ) {
77         loc_u->hev[i_w] = u3h(hev);
78         hev = u3t(hev);
79       }
80       loc_u->lev_w = i_w;
81     }
82     loc_u->kct_w = 0;
83     loc_u->kad = c3_malloc((1 + c3_min(loc_u->lev_w, loc_u->lel_w)) *
84                              sizeof(u3_noun));
85 
86     //  Compute equivalence classes.
87     //
88     loc_u->sev = u3_nul;
89     {
90       c3_w i_w;
91 
92       for ( i_w = 0; i_w < loc_u->lev_w; i_w++ ) {
93         u3_noun how = loc_u->hev[i_w];
94         u3_noun hav;
95         u3_noun teg;
96 
97         hav = u3kdb_get(u3k(loc_u->sev), u3k(how));
98         teg = u3nc(u3i_words(1, &i_w),
99                    (hav == u3_none) ? u3_nul : hav);
100         loc_u->sev = u3kdb_put(loc_u->sev, u3k(how), teg);
101       }
102     }
103   }
104 
105   //  apply
106   //
107   static void
_lune(u3_loss * loc_u,c3_w inx_w,c3_w goy_w)108   _lune(u3_loss* loc_u,
109         c3_w     inx_w,
110         c3_w     goy_w)
111   {
112     u3_noun kad;
113 
114     kad = u3nc(u3i_words(1, &goy_w),
115                (inx_w == 0) ? u3_nul
116                             : u3k(loc_u->kad[inx_w - 1]));
117     if ( loc_u->kct_w == inx_w ) {
118       c3_assert(loc_u->kct_w < (1 << 31));
119       loc_u->kct_w++;
120     } else {
121       u3z(loc_u->kad[inx_w]);
122     }
123     loc_u->kad[inx_w] = kad;
124   }
125 
126   //  extend fits top
127   //
128   static u3_noun
_hink(u3_loss * loc_u,c3_w inx_w,c3_w goy_w)129   _hink(u3_loss* loc_u,
130         c3_w     inx_w,
131         c3_w     goy_w)
132   {
133     return __
134          ( (loc_u->kct_w == inx_w) ||
135            (u3r_word(0, u3h(loc_u->kad[inx_w])) > goy_w) );
136   }
137 
138   //  extend fits bottom
139   //
140   static u3_noun
_lonk(u3_loss * loc_u,c3_w inx_w,c3_w goy_w)141   _lonk(u3_loss* loc_u,
142         c3_w     inx_w,
143         c3_w     goy_w)
144   {
145     return __
146       ( (0 == inx_w) ||
147         (u3r_word(0, u3h(loc_u->kad[inx_w - 1])) < goy_w) );
148   }
149 
150 #if 0
151   //  search for first index >= inx_w and <= max_w that fits
152   //  the hink and lonk criteria.
153   //
154   static u3_noun
155   _binka(u3_loss* loc_u,
156          c3_w*    inx_w,
157          c3_w     max_w,
158          c3_w     goy_w)
159   {
160     while ( *inx_w <= max_w ) {
161       if ( c3n == _lonk(loc_u, *inx_w, goy_w) ) {
162         return c3n;
163       }
164       if ( c3y == _hink(loc_u, *inx_w, goy_w) ) {
165         return c3y;
166       }
167       else ++*inx_w;
168     }
169     return c3n;
170   }
171 #endif
172 
173   //  search for lowest index >= inx_w and <= max_w for which
174   //  both hink(inx_w) and lonk(inx_w) are true.  lonk is false
175   //  if inx_w is too high, hink is false if it is too low.
176   //
177   static u3_noun
_bink(u3_loss * loc_u,c3_w * inx_w,c3_w max_w,c3_w goy_w)178   _bink(u3_loss* loc_u,
179         c3_w*    inx_w,
180         c3_w     max_w,
181         c3_w     goy_w)
182   {
183     c3_assert(max_w >= *inx_w);
184 
185     if ( max_w == *inx_w ) {
186       if ( c3n == _lonk(loc_u, *inx_w, goy_w) ) {
187         return c3n;
188       }
189       if ( c3y == _hink(loc_u, *inx_w, goy_w) ) {
190         return c3y;
191       }
192       else {
193         ++*inx_w;
194         return c3n;
195       }
196     }
197     else {
198       c3_w mid_w = *inx_w + ((max_w - *inx_w) / 2);
199 
200       if ( (c3n == _lonk(loc_u, mid_w, goy_w)) ||
201            (c3y == _hink(loc_u, mid_w, goy_w)) )
202       {
203         return _bink(loc_u, inx_w, mid_w, goy_w);
204       } else {
205         *inx_w = mid_w + 1;
206         return _bink(loc_u, inx_w, max_w, goy_w);
207       }
208     }
209   }
210 
211 
212   static void
_merg(u3_loss * loc_u,c3_w inx_w,u3_noun gay)213   _merg(u3_loss* loc_u,
214         c3_w     inx_w,
215         u3_noun  gay)
216   {
217     if ( (u3_nul == gay) || (inx_w > loc_u->kct_w) ) {
218       return;
219     }
220     else {
221       u3_noun i_gay = u3h(gay);
222       c3_w    goy_w = u3r_word(0, i_gay);
223       u3_noun bik;
224 
225       bik = _bink(loc_u, &inx_w, loc_u->kct_w, goy_w);
226 
227       if ( c3y == bik ) {
228         _merg(loc_u, inx_w + 1, u3t(gay));
229         _lune(loc_u, inx_w, goy_w);
230       }
231       else {
232         _merg(loc_u, inx_w, u3t(gay));
233       }
234     }
235   }
236 
237   //  compute lcs
238   //
239   static void
_loss(u3_loss * loc_u)240   _loss(u3_loss* loc_u)
241   {
242     while ( u3_nul != loc_u->hel ) {
243       u3_noun i_hel = u3h(loc_u->hel);
244       u3_noun guy   = u3kdb_get(u3k(loc_u->sev), u3k(i_hel));
245 
246       if ( u3_none != guy ) {
247         u3_noun gay = u3kb_flop(guy);
248 
249         _merg(loc_u, 0, gay);
250         u3z(gay);
251       }
252 
253       loc_u->hel = u3t(loc_u->hel);
254     }
255   }
256 
257   u3_noun
u3qe_loss(u3_noun hel,u3_noun hev)258   u3qe_loss(u3_noun hel,
259             u3_noun hev)
260   {
261     u3_loss loc_u;
262     u3_noun lcs;
263 
264     _lemp(&loc_u, hel, hev);
265     _loss(&loc_u);
266     lcs = _lexs(&loc_u);
267 
268     _flem(&loc_u);
269     return lcs;
270   }
271 
272   static u3_noun
_listp(u3_noun lix)273   _listp(u3_noun lix)
274   {
275     while ( 1 ) {
276       if ( u3_nul == lix ) return c3y;
277       if ( c3n == u3du(lix) ) return c3n;
278       lix = u3t(lix);
279     }
280   }
281 
282   u3_noun
u3we_loss(u3_noun cor)283   u3we_loss(u3_noun cor)
284   {
285     u3_noun hel, hev;
286 
287     if ( (u3_none == (hel = u3r_at(u3x_sam_2, cor))) ||
288          (u3_none == (hev = u3r_at(u3x_sam_3, cor))) ||
289          (c3n == _listp(hel)) ||
290          (c3n == _listp(hev)) )
291     {
292       return u3m_bail(c3__fail);
293     } else {
294       return u3qe_loss(hel, hev);
295     }
296   }
297