1:- import set_unify/2 from set_unify.
2:- import numbervars/1 from num_vars.
3:- import normalize_result/2 from can_mono.
4
5test :- tp, fail.
6test :- writeln('=========== Result is ================'), nl, show_facts.
7
8unify_sets([],[]).
9unify_sets([A|As],[B|Bs]) :-
10       set_unify(A,B), unify_sets(As,Bs).
11
12
13%---------------- Transformed program ----------------------
14
15solve_equation__1(_482,_484,_486) :-
16        [other] = _488, [_449] = _490, [_453] = _492,
17        factorize([[_406],[_410]],[_449],[[_434],[list]]),
18        remove_duplicates([_434],[_445]),
19        solve_factors([_445],[_449],[_453]),
20        normalize_result([_488,_490,_492],
21                         [_482,_484,_486]).
22solve_equation__1(_523,_525,_527) :-
23        [_471] = _529, [_449] = _531, [_491] = _533,
24        single_occurrence([_449],[_471]),
25        position([_449],[_471],[list,_483]),
26        maneuver_sides([_467],[_471],[_487]),
27        isolate([_483],[_487],[_491]),
28        normalize_result([_529,_531,_533],
29                         [_523,_525,_527]).
30solve_equation__1(_516,_518,_520) :-
31        [other] = _522, [_480] = _524, [_484] = _526,
32        is_polynomial([_454],[_480]),
33        is_polynomial([_458],[_480]),
34        polynomial_normal_form([[_454],[_458]],[_480],[_476]),
35        solve_polynomial_equation([_476],[_480],[_484]),
36        normalize_result([_522,_524,_526],
37                         [_516,_518,_520]).
38solve_equation__1(_631,_633,_635) :-
39        [_546] = _637, [_592] = _639, [_596] = _641,
40        offenders([_546],[_592],[_554]),
41        multiple([_554]),
42        homogenize([_546],[_592],[_554],[_572],[_576]),
43        solve_equation([_572],[_576],[_588]),
44        solve_equation([_588],[_592],[_596]),
45        normalize_result([_637,_639,_641],
46                         [_631,_633,_635]).
47factorize__1(_492,_494,_496) :-
48        [[_430],[_452]] = _498, [_456] = _500, [[_438],[_464]] = _502,
49        factorize([_430],[_456],[[_438],[_460]]),
50        factorize([_452],[_456],[[_460],[_464]]),
51        normalize_result([_498,_500,_502],
52                         [_492,_494,_496]).
53factorize__1(_278,_280,_282) :-
54        [_256] = _284, [_252] = _286, [[list,_235],[_235]] = _288,
55        subterm([_252],[_256]),
56        normalize_result([_284,_286,_288],
57                         [_278,_280,_282]).
58factorize__1(_191,_193,_195) :-
59        [_161] = _197, [_165] = _199, [[_173],[_173]] = _201,
60        normalize_result([_197,_199,_201],
61                          [_191,_193,_195]).
62solve_factors__1(_265,_267,_269) :-
63        [list,_84] = _271, [_238] = _273, [_242] = _275,
64        solve_equation([other],[_238],[_242]),
65        normalize_result([_271,_273,_275],
66                         [_265,_267,_269]).
67solve_factors__1(_269,_271,_273) :-
68        [list,_238] = _275, [_242] = _277, [_246] = _279,
69        solve_factors([_238],[_242],[_246]),
70        normalize_result([_275,_277,_279],
71                         [_269,_271,_273]).
72single_occurrence__1(_226,_228) :-
73        [_197] = _230, [_201] = _232,
74        occurrence([_197],[_201],[num]),
75        normalize_result([_230,_232],
76                         [_226,_228]).
77maneuver_sides__1(_139,_141,_143) :-
78        [num] = _145, [other] = _147, [other] = _149,
79        normalize_result([_145,_147,_149],
80                          [_139,_141,_143]).
81maneuver_sides__1(_139,_141,_143) :-
82        [num] = _145, [other] = _147, [other] = _149,
83        normalize_result([_145,_147,_149],
84                          [_139,_141,_143]).
85isolate__1(_364,_366,_368) :-
86        [list,_330] = _370, [_318] = _372, [_338] = _374,
87        isolax([_314],[_318],[_334]),
88        isolate([_330],[_334],[_338]),
89        normalize_result([_370,_372,_374],
90                         [_364,_366,_368]).
91isolate__1(_149,_151,_153) :-
92        [list] = _155, [_133] = _157, [_133] = _159,
93        normalize_result([_155,_157,_159],
94                          [_149,_151,_153]).
95isolax__1(_139,_141,_143) :-
96        [num] = _145, [other] = _147, [other] = _149,
97        normalize_result([_145,_147,_149],
98                          [_139,_141,_143]).
99isolax__1(_139,_141,_143) :-
100        [num] = _145, [other] = _147, [other] = _149,
101        normalize_result([_145,_147,_149],
102                          [_139,_141,_143]).
103isolax__1(_139,_141,_143) :-
104        [num] = _145, [other] = _147, [other] = _149,
105        normalize_result([_145,_147,_149],
106                          [_139,_141,_143]).
107isolax__1(_139,_141,_143) :-
108        [num] = _145, [other] = _147, [other] = _149,
109        normalize_result([_145,_147,_149],
110                          [_139,_141,_143]).
111isolax__1(_209,_211,_213) :-
112        [num] = _215, [other] = _217, [other] = _219,
113        'my =\\='([_176],[num]),
114        normalize_result([_215,_217,_219],
115                         [_209,_211,_213]).
116isolax__1(_209,_211,_213) :-
117        [num] = _215, [other] = _217, [other] = _219,
118        'my =\\='([_176],[num]),
119        normalize_result([_215,_217,_219],
120                         [_209,_211,_213]).
121isolax__1(_209,_211,_213) :-
122        [num] = _215, [other] = _217, [other] = _219,
123        'my =\\='([_176],[num]),
124        normalize_result([_215,_217,_219],
125                         [_209,_211,_213]).
126isolax__1(_209,_211,_213) :-
127        [num] = _215, [other] = _217, [other] = _219,
128        'my =\\='([_176],[num]),
129        normalize_result([_215,_217,_219],
130                         [_209,_211,_213]).
131isolax__1(_139,_141,_143) :-
132        [num] = _145, [other] = _147, [other] = _149,
133        normalize_result([_145,_147,_149],
134                          [_139,_141,_143]).
135isolax__1(_139,_141,_143) :-
136        [num] = _145, [other] = _147, [other] = _149,
137        normalize_result([_145,_147,_149],
138                          [_139,_141,_143]).
139isolax__1(_139,_141,_143) :-
140        [num] = _145, [other] = _147, [other] = _149,
141        normalize_result([_145,_147,_149],
142                          [_139,_141,_143]).
143isolax__1(_139,_141,_143) :-
144        [num] = _145, [other] = _147, [other] = _149,
145        normalize_result([_145,_147,_149],
146                          [_139,_141,_143]).
147isolax__1(_139,_141,_143) :-
148        [num] = _145, [other] = _147, [other] = _149,
149        normalize_result([_145,_147,_149],
150                          [_139,_141,_143]).
151isolax__1(_139,_141,_143) :-
152        [num] = _145, [other] = _147, [other] = _149,
153        normalize_result([_145,_147,_149],
154                          [_139,_141,_143]).
155is_polynomial__1(_126,_128) :-
156        [_113] = _130, [_113] = _132,
157        normalize_result([_130,_132],
158                          [_126,_128]).
159is_polynomial__1(_180,_182) :-
160        [_161] = _184, [_147] = _186,
161        constant([_161]),
162        normalize_result([_184,_186],
163                         [_180,_182]).
164is_polynomial__1(_307,_309) :-
165        [[_269],[_280]] = _311, [_284] = _313,
166        is_polynomial([_269],[_284]),
167        is_polynomial([_280],[_284]),
168        normalize_result([_311,_313],
169                         [_307,_309]).
170is_polynomial__1(_307,_309) :-
171        [[_269],[_280]] = _311, [_284] = _313,
172        is_polynomial([_269],[_284]),
173        is_polynomial([_280],[_284]),
174        normalize_result([_311,_313],
175                         [_307,_309]).
176is_polynomial__1(_307,_309) :-
177        [[_269],[_280]] = _311, [_284] = _313,
178        is_polynomial([_269],[_284]),
179        is_polynomial([_280],[_284]),
180        normalize_result([_311,_313],
181                         [_307,_309]).
182is_polynomial__1(_282,_284) :-
183        [[_249],[_260]] = _286, [_253] = _288,
184        is_polynomial([_249],[_253]),
185        constant([_260]),
186        normalize_result([_286,_288],
187                         [_282,_284]).
188is_polynomial__1(_282,_284) :-
189        [[_255],[_249]] = _286, [_259] = _288,
190        natural_number([_249]),
191        is_polynomial([_255],[_259]),
192        normalize_result([_286,_288],
193                         [_282,_284]).
194natural_number__1(_167) :-
195        [_138] = _169,
196        'my >'([_138],[num]),
197        normalize_result([_169],
198                         [_167]).
199polynomial_normal_form__1(_327,_329,_331) :-
200        [_282] = _333, [_286] = _335, [_302] = _337,
201        polynomial_form([_282],[_286],[_298]),
202        remove_zero_terms([_298],[_302]),
203        normalize_result([_333,_335,_337],
204                         [_327,_329,_331]).
205polynomial_form__1(_159,_161,_163) :-
206        [_137] = _165, [_137] = _167, [list,list] = _169,
207        normalize_result([_165,_167,_169],
208                          [_159,_161,_163]).
209polynomial_form__1(_195,_197,_199) :-
210        [[_173],[_167]] = _201, [_173] = _203, [list,list] = _205,
211        normalize_result([_201,_203,_205],
212                          [_195,_197,_199]).
213polynomial_form__1(_481,_483,_485) :-
214        [[_412],[_428]] = _487, [_432] = _489, [_452] = _491,
215        polynomial_form([_412],[_432],[_444]),
216        polynomial_form([_428],[_432],[_448]),
217        add_polynomials([_444],[_448],[_452]),
218        normalize_result([_487,_489,_491],
219                         [_481,_483,_485]).
220polynomial_form__1(_481,_483,_485) :-
221        [[_412],[_428]] = _487, [_432] = _489, [_452] = _491,
222        polynomial_form([_412],[_432],[_444]),
223        polynomial_form([_428],[_432],[_448]),
224        subtract_polynomials([_444],[_448],[_452]),
225        normalize_result([_487,_489,_491],
226                         [_481,_483,_485]).
227polynomial_form__1(_481,_483,_485) :-
228        [[_412],[_428]] = _487, [_432] = _489, [_452] = _491,
229        polynomial_form([_412],[_432],[_444]),
230        polynomial_form([_428],[_432],[_448]),
231        multiply_polynomials([_444],[_448],[_452]),
232        normalize_result([_487,_489,_491],
233                         [_481,_483,_485]).
234polynomial_form__1(_388,_390,_392) :-
235        [[_338],[_358]] = _394, [_342] = _396, [_362] = _398,
236        polynomial_form([_338],[_342],[_354]),
237        binomial([_354],[_358],[_362]),
238        normalize_result([_394,_396,_398],
239                         [_388,_390,_392]).
240polynomial_form__1(_238,_240,_242) :-
241        [_216] = _244, [_212] = _246, [list,list] = _248,
242        free_of([_212],[_216]),
243        normalize_result([_244,_246,_248],
244                         [_238,_240,_242]).
245remove_zero_terms__1(_215,_217) :-
246        [list,_191] = _219, [_195] = _221,
247        remove_zero_terms([_191],[_195]),
248        normalize_result([_219,_221],
249                         [_215,_217]).
250remove_zero_terms__1(_284,_286) :-
251        [list,_257] = _288, [list,_261] = _290,
252        'my =\\='([_239],[num]),
253        remove_zero_terms([_257],[_261]),
254        normalize_result([_288,_290],
255                         [_284,_286]).
256remove_zero_terms__1(_116,_118) :-
257        [list] = _120, [list] = _122,
258        normalize_result([_120,_122],
259                          [_116,_118]).
260add_polynomials__1(_149,_151,_153) :-
261        [list] = _155, [_133] = _157, [_133] = _159,
262        normalize_result([_155,_157,_159],
263                          [_149,_151,_153]).
264add_polynomials__1(_149,_151,_153) :-
265        [_133] = _155, [list] = _157, [_133] = _159,
266        normalize_result([_155,_157,_159],
267                          [_149,_151,_153]).
268add_polynomials__1(_364,_366,_368) :-
269        [list,_328] = _370, [list,_114] = _372, [list,_338] = _374,
270        'my >'([_310],[_319]),
271        add_polynomials([_328],[list,_114],[_338]),
272        normalize_result([_370,_372,_374],
273                         [_364,_366,_368]).
274add_polynomials__1(_455,_457,_459) :-
275        [list,_418] = _461, [list,_422] = _463, [list,_426] = _465,
276        'my =:='([_376],[_385]),
277        'my is'([_394],[[_403],[_407]]),
278        add_polynomials([_418],[_422],[_426]),
279        normalize_result([_461,_463,_465],
280                         [_455,_457,_459]).
281add_polynomials__1(_364,_366,_368) :-
282        [list,_84] = _370, [list,_334] = _372, [list,_338] = _374,
283        'my <'([_310],[_319]),
284        add_polynomials([list,_84],[_334],[_338]),
285        normalize_result([_370,_372,_374],
286                         [_364,_366,_368]).
287subtract_polynomials__1(_348,_350,_352) :-
288        [_314] = _354, [_298] = _356, [_322] = _358,
289        multiply_single([_298],[other],[_318]),
290        add_polynomials([_314],[_318],[_322]),
291        normalize_result([_354,_356,_358],
292                         [_348,_350,_352]).
293multiply_single__1(_471,_473,_475) :-
294        [list,_434] = _477, [other] = _479, [list,_442] = _481,
295        'my is'([_386],[[_395],[_399]]),
296        'my is'([_410],[[_419],[_423]]),
297        multiply_single([_434],[other],[_442]),
298        normalize_result([_477,_479,_481],
299                         [_471,_473,_475]).
300multiply_single__1(_145,_147,_149) :-
301        [list] = _151, [_125] = _153, [list] = _155,
302        normalize_result([_151,_153,_155],
303                          [_145,_147,_149]).
304multiply_polynomials__1(_451,_453,_455) :-
305        [list,_398] = _457, [_402] = _459, [_422] = _461,
306        multiply_single([_402],[other],[_414]),
307        multiply_polynomials([_398],[_402],[_418]),
308        add_polynomials([_414],[_418],[_422]),
309        normalize_result([_457,_459,_461],
310                         [_451,_453,_455]).
311multiply_polynomials__1(_145,_147,_149) :-
312        [list] = _151, [_125] = _153, [list] = _155,
313        normalize_result([_151,_153,_155],
314                          [_145,_147,_149]).
315binomial__1(_149,_151,_153) :-
316        [_133] = _155, [num] = _157, [_133] = _159,
317        normalize_result([_155,_157,_159],
318                          [_149,_151,_153]).
319solve_polynomial_equation__1(_285,_287,_289) :-
320        [_252] = _291, [_227] = _293, [other] = _295,
321        linear([_252]),
322        pad([_252],[list,list,list]),
323        normalize_result([_291,_293,_295],
324                         [_285,_287,_289]).
325solve_polynomial_equation__1(_591,_593,_595) :-
326        [_498] = _597, [_536] = _599, [_556] = _601,
327        quadratic([_498]),
328        pad([_498],[list,list,list,list]),
329        discriminant([_540],[_544],[_548],[_552]),
330        root([_536],[_540],[_544],[_548],[_552],[_556]),
331        normalize_result([_597,_599,_601],
332                         [_591,_593,_595]).
333discriminant__1(_390,_392,_394,_396) :-
334        [_354] = _398, [_344] = _400, [_360] = _402, [_331] = _404,
335        'my is'([_331],[[[_344],[_344]],[[[num],[_354]],[_360]]]),
336        normalize_result([_398,_400,_402,_404],
337                         [_390,_392,_394,_396]).
338root__1(_232,_234,_236,_238,_240,_242) :-
339        [_187] = _244, [_191] = _246, [_195] = _248, [_199] = _250, [num] = _252, [other] = _254,
340        normalize_result([_244,_246,_248,_250,_252,_254],
341                          [_232,_234,_236,_238,_240,_242]).
342root__1(_306,_308,_310,_312,_314,_316) :-
343        [_229] = _318, [_233] = _320, [_237] = _322, [_241] = _324, [_267] = _326, [other] = _328,
344        'my >'([_267],[num]),
345        normalize_result([_318,_320,_322,_324,_326,_328],
346                         [_306,_308,_310,_312,_314,_316]).
347root__1(_306,_308,_310,_312,_314,_316) :-
348        [_229] = _318, [_233] = _320, [_237] = _322, [_241] = _324, [_267] = _326, [other] = _328,
349        'my >'([_267],[num]),
350        normalize_result([_318,_320,_322,_324,_326,_328],
351                         [_306,_308,_310,_312,_314,_316]).
352pad__1(_225,_227) :-
353        [list,_201] = _229, [list,_205] = _231,
354        pad([_201],[_205]),
355        normalize_result([_229,_231],
356                         [_225,_227]).
357pad__1(_215,_217) :-
358        [_191] = _219, [list,_195] = _221,
359        pad([_191],[_195]),
360        normalize_result([_219,_221],
361                         [_215,_217]).
362pad__1(_116,_118) :-
363        [list] = _120, [list] = _122,
364        normalize_result([_120,_122],
365                          [_116,_118]).
366linear__1(_109) :-
367        [list,_84] = _111,
368        normalize_result([_111],
369                          [_109]).
370quadratic__1(_109) :-
371        [list,_84] = _111,
372        normalize_result([_111],
373                          [_109]).
374offenders__1(_333,_335,_337) :-
375        [_263] = _339, [_292] = _341, [_308] = _343,
376        parse([list,list],[_292],[_304]),
377        remove_duplicates([_304],[_308]),
378        normalize_result([_339,_341,_343],
379                         [_333,_335,_337]).
380homogenize__1(_553,_555,_557,_559,_561) :-
381        [_512] = _563, [_470] = _565, [_491] = _567, [_520] = _569, [_499] = _571,
382        reduced_term([_470],[_491],[_495],[_499]),
383        rewrite([_491],[_495],[_499],[_516]),
384        substitute([_512],[_516],[_520]),
385        normalize_result([_563,_565,_567,_569,_571],
386                         [_553,_555,_557,_559,_561]).
387reduced_term__1(_404,_406,_408,_410) :-
388        [_371] = _412, [_367] = _414, [_363] = _416, [_375] = _418,
389        classify([_367],[_371],[_363]),
390        candidate([_363],[_367],[_371],[_375]),
391        normalize_result([_412,_414,_416,_418],
392                         [_404,_406,_408,_410]).
393classify__1(_228,_230,_232) :-
394        [_202] = _234, [_206] = _236, [atom] = _238,
395        exponential_offenders([_202],[_206]),
396        normalize_result([_234,_236,_238],
397                         [_228,_230,_232]).
398exponential_offenders__1(_351,_353) :-
399        [list,_321] = _355, [_325] = _357,
400        free_of([_325],[_303]),
401        subterm([_325],[_314]),
402        exponential_offenders([_321],[_325]),
403        normalize_result([_355,_357],
404                         [_351,_353]).
405exponential_offenders__1(_122,_124) :-
406        [list] = _126, [_109] = _128,
407        normalize_result([_126,_128],
408                          [_122,_124]).
409candidate__1(_357,_359,_361,_363) :-
410        [atom] = _365, [_326] = _367, [_330] = _369, [[_319],[_330]] = _371,
411        base([_326],[_319]),
412        polynomial_exponents([_326],[_330]),
413        normalize_result([_365,_367,_369,_371],
414                         [_357,_359,_361,_363]).
415base__1(_215,_217) :-
416        [list,_191] = _219, [_195] = _221,
417        base([_191],[_195]),
418        normalize_result([_219,_221],
419                         [_215,_217]).
420base__1(_122,_124) :-
421        [list] = _126, [_109] = _128,
422        normalize_result([_126,_128],
423                          [_122,_124]).
424polynomial_exponents__1(_283,_285) :-
425        [list,_256] = _287, [_260] = _289,
426        is_polynomial([_245],[_260]),
427        polynomial_exponents([_256],[_260]),
428        normalize_result([_287,_289],
429                         [_283,_285]).
430polynomial_exponents__1(_122,_124) :-
431        [list] = _126, [_109] = _128,
432        normalize_result([_126,_128],
433                          [_122,_124]).
434substitute__1(_422,_424,_426) :-
435        [[_372],[_388]] = _428, [_392] = _430, [[_380],[_396]] = _432,
436        substitute([_372],[_392],[_380]),
437        substitute([_388],[_392],[_396]),
438        normalize_result([_428,_430,_432],
439                         [_422,_424,_426]).
440substitute__1(_422,_424,_426) :-
441        [[_372],[_388]] = _428, [_392] = _430, [[_380],[_396]] = _432,
442        substitute([_372],[_392],[_380]),
443        substitute([_388],[_392],[_396]),
444        normalize_result([_428,_430,_432],
445                         [_422,_424,_426]).
446substitute__1(_422,_424,_426) :-
447        [[_372],[_388]] = _428, [_392] = _430, [[_380],[_396]] = _432,
448        substitute([_372],[_392],[_380]),
449        substitute([_388],[_392],[_396]),
450        normalize_result([_428,_430,_432],
451                         [_422,_424,_426]).
452substitute__1(_346,_348,_350) :-
453        [other] = _352, [_316] = _354, [other] = _356,
454        substitute([_296],[_316],[_304]),
455        substitute([_312],[_316],[_320]),
456        normalize_result([_352,_354,_356],
457                         [_346,_348,_350]).
458substitute__1(_370,_372,_374) :-
459        [[_336],[_330]] = _376, [_340] = _378, [[_344],[_330]] = _380,
460        integer([_330]),
461        substitute([_336],[_340],[_344]),
462        normalize_result([_376,_378,_380],
463                         [_370,_372,_374]).
464substitute__1(_230,_232,_234) :-
465        [_181] = _236, [_208] = _238, [_189] = _240,
466        member([other],[_208]),
467        normalize_result([_236,_238,_240],
468                         [_230,_232,_234]).
469substitute__1(_155,_157,_159) :-
470        [_139] = _161, [_135] = _163, [_139] = _165,
471        normalize_result([_161,_163,_165],
472                          [_155,_157,_159]).
473rewrite__1(_453,_455,_457,_459) :-
474        [list,_412] = _461, [_416] = _463, [_420] = _465, [list,_424] = _467,
475        homog_axiom([_416],[_395],[_420],[_403]),
476        rewrite([_412],[_416],[_420],[_424]),
477        normalize_result([_461,_463,_465,_467],
478                         [_453,_455,_457,_459]).
479rewrite__1(_174,_176,_178,_180) :-
480        [list] = _182, [_147] = _184, [_151] = _186, [list] = _188,
481        normalize_result([_182,_184,_186,_188],
482                          [_174,_176,_178,_180]).
483homog_axiom__1(_350,_352,_354,_356) :-
484        [atom] = _358, [[_319],[[_329],[_323]]] = _360, [[_319],[_323]] = _362, [[[_319],[_323]],[_329]] = _364,
485        normalize_result([_358,_360,_362,_364],
486                          [_350,_352,_354,_356]).
487homog_axiom__1(_310,_312,_314,_316) :-
488        [atom] = _318, [[_283],[_287]] = _320, [[_283],[_287]] = _322, [[num],[[_283],[_287]]] = _324,
489        normalize_result([_318,_320,_322,_324],
490                          [_310,_312,_314,_316]).
491homog_axiom__1(_384,_386,_388,_390) :-
492        [atom] = _392, [[_357],[[_361],[_351]]] = _394, [[_357],[_361]] = _396, [[[_357],[_351]],[[_357],[_361]]] = _398,
493        normalize_result([_392,_394,_396,_398],
494                          [_384,_386,_388,_390]).
495subterm__1(_126,_128) :-
496        [_113] = _130, [_113] = _132,
497        normalize_result([_130,_132],
498                          [_126,_128]).
499subterm__1(_366,_368) :-
500        [_335] = _370, [_339] = _372,
501        compound([_339]),
502        functor([_339],[_319],[_331]),
503        subterm([_331],[_335],[_339]),
504        normalize_result([_370,_372],
505                         [_366,_368]).
506constant__1(_93) :-
507        [num] = _95,
508        normalize_result([_95],
509                          [_93]).
510constant__1(_93) :-
511        [num] = _95,
512        normalize_result([_95],
513                          [_93]).
514member__1(_138,_140) :-
515        [_119] = _142, [list,_106] = _144,
516        normalize_result([_142,_144],
517                          [_138,_140]).
518member__1(_215,_217) :-
519        [_191] = _219, [list,_195] = _221,
520        member([_191],[_195]),
521        normalize_result([_219,_221],
522                         [_215,_217]).
523subterm__1(_230,_232,_234) :-
524        [num] = _236, [_204] = _238, [_189] = _240,
525        subterm([_204],[_208]),
526        normalize_result([_236,_238,_240],
527                         [_230,_232,_234]).
528subterm__1(_409,_411,_413) :-
529        [_357] = _415, [_376] = _417, [_380] = _419,
530        'my >'([_357],[num]),
531        'my is'([_372],[[_357],[num]]),
532        subterm([_372],[_376],[_380]),
533        normalize_result([_415,_417,_419],
534                         [_409,_411,_413]).
535position__1(_149,_151,_153) :-
536        [_129] = _155, [_129] = _157, [list] = _159,
537        normalize_result([_155,_157,_159],
538                          [_149,_151,_153]).
539position__1(_420,_422,_424) :-
540        [_382] = _426, [_386] = _428, [_390] = _430,
541        compound([_386]),
542        functor([_386],[_366],[_378]),
543        position([_378],[_382],[_386],[_390]),
544        normalize_result([_426,_428,_430],
545                         [_420,_422,_424]).
546position__1(_294,_296,_298,_300) :-
547        [num] = _302, [_261] = _304, [_239] = _306, [list,_269] = _308,
548        position([_261],[_265],[_269]),
549        normalize_result([_302,_304,_306,_308],
550                         [_294,_296,_298,_300]).
551position__1(_463,_465,_467,_469) :-
552        [_404] = _471, [_423] = _473, [_427] = _475, [_431] = _477,
553        'my >'([_404],[num]),
554        'my is'([_419],[[_404],[num]]),
555        position([_419],[_423],[_427],[_431]),
556        normalize_result([_471,_473,_475,_477],
557                         [_463,_465,_467,_469]).
558parse__1(_289,_291,_293) :-
559        [list,_84] = _295, [_262] = _297, [_266] = _299,
560        parse([list,list,_84],[_262],[_266]),
561        normalize_result([_295,_297,_299],
562                         [_289,_291,_293]).
563parse__1(_289,_291,_293) :-
564        [list,_84] = _295, [_262] = _297, [_266] = _299,
565        parse([list,list,_84],[_262],[_266]),
566        normalize_result([_295,_297,_299],
567                         [_289,_291,_293]).
568parse__1(_289,_291,_293) :-
569        [list,_84] = _295, [_262] = _297, [_266] = _299,
570        parse([list,list,_84],[_262],[_266]),
571        normalize_result([_295,_297,_299],
572                         [_289,_291,_293]).
573parse__1(_289,_291,_293) :-
574        [list,_84] = _295, [_262] = _297, [_266] = _299,
575        parse([list,list,_84],[_262],[_266]),
576        normalize_result([_295,_297,_299],
577                         [_289,_291,_293]).
578parse__1(_322,_324,_326) :-
579        [list,_84] = _328, [_292] = _330, [_296] = _332,
580        integer([_280]),
581        parse([list,_84],[_292],[_296]),
582        normalize_result([_328,_330,_332],
583                         [_322,_324,_326]).
584parse__1(_269,_271,_273) :-
585        [list,_238] = _275, [_242] = _277, [_246] = _279,
586        parse([_238],[_242],[_246]),
587        normalize_result([_275,_277,_279],
588                         [_269,_271,_273]).
589parse__1(_279,_281,_283) :-
590        [list,_248] = _285, [_252] = _287, [list,_256] = _289,
591        parse([_248],[_252],[_256]),
592        normalize_result([_285,_287,_289],
593                         [_279,_281,_283]).
594parse__1(_145,_147,_149) :-
595        [list] = _151, [_125] = _153, [list] = _155,
596        normalize_result([_151,_153,_155],
597                          [_145,_147,_149]).
598free_of__1(_289,_291) :-
599        [_239] = _293, [_243] = _295,
600        occurrence([_239],[_243],[_255]),
601        'my ='([_255],[num]),
602        normalize_result([_293,_295],
603                         [_289,_291]).
604single_occurrence__1(_128,_130) :-
605        [_111] = _132, [_115] = _134,
606        normalize_result([_132,_134],
607                          [_128,_130]).
608occurrence__1(_149,_151,_153) :-
609        [_129] = _155, [_129] = _157, [num] = _159,
610        normalize_result([_155,_157,_159],
611                          [_149,_151,_153]).
612occurrence__1(_441,_443,_445) :-
613        [_398] = _447, [_402] = _449, [_410] = _451,
614        compound([_402]),
615        functor([_402],[_382],[_394]),
616        occurrence([_394],[_398],[_402],[num],[_410]),
617        normalize_result([_447,_449,_451],
618                         [_441,_443,_445]).
619occurrence__1(_151,_153,_155) :-
620        [_127] = _157, [_131] = _159, [num] = _161,
621        normalize_result([_157,_159,_161],
622                          [_151,_153,_155]).
623occurrence__1(_709,_711,_713,_715,_717) :-
624        [_637] = _719, [_656] = _721, [_660] = _723, [_617] = _725, [_668] = _727,
625        'my >'([_637],[num]),
626        occurrence([_656],[_592],[_613]),
627        'my is'([_664],[[_613],[_617]]),
628        'my is'([_652],[[_637],[num]]),
629        occurrence([_652],[_656],[_660],[_664],[_668]),
630        normalize_result([_719,_721,_723,_725,_727],
631                         [_709,_711,_713,_715,_717]).
632occurrence__1(_207,_209,_211,_213,_215) :-
633        [num] = _217, [_173] = _219, [_177] = _221, [_185] = _223, [_185] = _225,
634        normalize_result([_217,_219,_221,_223,_225],
635                          [_207,_209,_211,_213,_215]).
636multiple__1(_119) :-
637        [list,list,_92] = _121,
638        normalize_result([_121],
639                          [_119]).
640remove_duplicates__1(_116,_118) :-
641        [list] = _120, [list] = _122,
642        normalize_result([_120,_122],
643                          [_116,_118]).
644remove_duplicates__1(_225,_227) :-
645        [list,_201] = _229, [list,_205] = _231,
646        remove_duplicates([_201],[_205]),
647        normalize_result([_229,_231],
648                         [_225,_227]).
649remove_duplicates__1(_283,_285) :-
650        [list,_256] = _287, [_260] = _289,
651        member([_245],[_256]),
652        remove_duplicates([_256],[_260]),
653        normalize_result([_287,_289],
654                         [_283,_285]).
655test_press__1(_325,_327) :-
656        [_277] = _329, [_301] = _331,
657        equation([_277],[_293],[_297]),
658        solve_equation([_293],[_297],[_301]),
659        normalize_result([_329,_331],
660                         [_325,_327]).
661equation__1(_139,_141,_143) :-
662        [num] = _145, [atom] = _147, [atom] = _149,
663        normalize_result([_145,_147,_149],
664                          [_139,_141,_143]).
665equation__1(_139,_141,_143) :-
666        [num] = _145, [atom] = _147, [atom] = _149,
667        normalize_result([_145,_147,_149],
668                          [_139,_141,_143]).
669
670%---------------- Definitions of tabled preds --------------
671
672:- table equation__1/3.
673:- table test_press__1/2.
674:- table remove_duplicates__1/2.
675:- table multiple__1/1.
676:- table occurrence__1/5.
677:- table occurrence__1/3.
678:- table free_of__1/2.
679:- table parse__1/3.
680:- table position__1/4.
681:- table position__1/3.
682:- table subterm__1/3.
683:- table member__1/2.
684:- table constant__1/1.
685:- table subterm__1/2.
686:- table homog_axiom__1/4.
687:- table rewrite__1/4.
688:- table substitute__1/3.
689:- table polynomial_exponents__1/2.
690:- table base__1/2.
691:- table candidate__1/4.
692:- table exponential_offenders__1/2.
693:- table classify__1/3.
694:- table reduced_term__1/4.
695:- table homogenize__1/5.
696:- table offenders__1/3.
697:- table quadratic__1/1.
698:- table linear__1/1.
699:- table pad__1/2.
700:- table root__1/6.
701:- table discriminant__1/4.
702:- table solve_polynomial_equation__1/3.
703:- table binomial__1/3.
704:- table multiply_polynomials__1/3.
705:- table multiply_single__1/3.
706:- table subtract_polynomials__1/3.
707:- table add_polynomials__1/3.
708:- table remove_zero_terms__1/2.
709:- table polynomial_form__1/3.
710:- table polynomial_normal_form__1/3.
711:- table natural_number__1/1.
712:- table is_polynomial__1/2.
713:- table isolax__1/3.
714:- table isolate__1/3.
715:- table maneuver_sides__1/3.
716:- table single_occurrence__1/2.
717:- table solve_factors__1/3.
718:- table factorize__1/3.
719:- table solve_equation__1/3.
720
721equation(_63,_65,_67) :-
722        equation__1(_69,_71,_73),
723        unify_sets([_63,_65,_67], [_69,_71,_73]).
724test_press(_63,_65) :-
725        test_press__1(_67,_69),
726        unify_sets([_63,_65], [_67,_69]).
727remove_duplicates(_63,_65) :-
728        remove_duplicates__1(_67,_69),
729        unify_sets([_63,_65], [_67,_69]).
730multiple(_63) :-
731        multiple__1(_65),
732        unify_sets([_63], [_65]).
733occurrence(_63,_65,_67,_69,_71) :-
734        occurrence__1(_73,_75,_77,_79,_81),
735        unify_sets([_63,_65,_67,_69,_71], [_73,_75,_77,_79,_81]).
736occurrence(_63,_65,_67) :-
737        occurrence__1(_69,_71,_73),
738        unify_sets([_63,_65,_67], [_69,_71,_73]).
739free_of(_63,_65) :-
740        free_of__1(_67,_69),
741        unify_sets([_63,_65], [_67,_69]).
742parse(_63,_65,_67) :-
743        parse__1(_69,_71,_73),
744        unify_sets([_63,_65,_67], [_69,_71,_73]).
745position(_63,_65,_67,_69) :-
746        position__1(_71,_73,_75,_77),
747        unify_sets([_63,_65,_67,_69], [_71,_73,_75,_77]).
748position(_63,_65,_67) :-
749        position__1(_69,_71,_73),
750        unify_sets([_63,_65,_67], [_69,_71,_73]).
751subterm(_63,_65,_67) :-
752        subterm__1(_69,_71,_73),
753        unify_sets([_63,_65,_67], [_69,_71,_73]).
754member(_63,_65) :-
755        member__1(_67,_69),
756        unify_sets([_63,_65], [_67,_69]).
757constant(_63) :-
758        constant__1(_65),
759        unify_sets([_63], [_65]).
760subterm(_63,_65) :-
761        subterm__1(_67,_69),
762        unify_sets([_63,_65], [_67,_69]).
763homog_axiom(_63,_65,_67,_69) :-
764        homog_axiom__1(_71,_73,_75,_77),
765        unify_sets([_63,_65,_67,_69], [_71,_73,_75,_77]).
766rewrite(_63,_65,_67,_69) :-
767        rewrite__1(_71,_73,_75,_77),
768        unify_sets([_63,_65,_67,_69], [_71,_73,_75,_77]).
769substitute(_63,_65,_67) :-
770        substitute__1(_69,_71,_73),
771        unify_sets([_63,_65,_67], [_69,_71,_73]).
772polynomial_exponents(_63,_65) :-
773        polynomial_exponents__1(_67,_69),
774        unify_sets([_63,_65], [_67,_69]).
775base(_63,_65) :-
776        base__1(_67,_69),
777        unify_sets([_63,_65], [_67,_69]).
778candidate(_63,_65,_67,_69) :-
779        candidate__1(_71,_73,_75,_77),
780        unify_sets([_63,_65,_67,_69], [_71,_73,_75,_77]).
781exponential_offenders(_63,_65) :-
782        exponential_offenders__1(_67,_69),
783        unify_sets([_63,_65], [_67,_69]).
784classify(_63,_65,_67) :-
785        classify__1(_69,_71,_73),
786        unify_sets([_63,_65,_67], [_69,_71,_73]).
787reduced_term(_63,_65,_67,_69) :-
788        reduced_term__1(_71,_73,_75,_77),
789        unify_sets([_63,_65,_67,_69], [_71,_73,_75,_77]).
790homogenize(_63,_65,_67,_69,_71) :-
791        homogenize__1(_73,_75,_77,_79,_81),
792        unify_sets([_63,_65,_67,_69,_71], [_73,_75,_77,_79,_81]).
793offenders(_63,_65,_67) :-
794        offenders__1(_69,_71,_73),
795        unify_sets([_63,_65,_67], [_69,_71,_73]).
796quadratic(_63) :-
797        quadratic__1(_65),
798        unify_sets([_63], [_65]).
799linear(_63) :-
800        linear__1(_65),
801        unify_sets([_63], [_65]).
802pad(_63,_65) :-
803        pad__1(_67,_69),
804        unify_sets([_63,_65], [_67,_69]).
805root(_63,_65,_67,_69,_71,_73) :-
806        root__1(_75,_77,_79,_81,_83,_85),
807        unify_sets([_63,_65,_67,_69,_71,_73], [_75,_77,_79,_81,_83,_85]).
808discriminant(_63,_65,_67,_69) :-
809        discriminant__1(_71,_73,_75,_77),
810        unify_sets([_63,_65,_67,_69], [_71,_73,_75,_77]).
811solve_polynomial_equation(_63,_65,_67) :-
812        solve_polynomial_equation__1(_69,_71,_73),
813        unify_sets([_63,_65,_67], [_69,_71,_73]).
814binomial(_63,_65,_67) :-
815        binomial__1(_69,_71,_73),
816        unify_sets([_63,_65,_67], [_69,_71,_73]).
817multiply_polynomials(_63,_65,_67) :-
818        multiply_polynomials__1(_69,_71,_73),
819        unify_sets([_63,_65,_67], [_69,_71,_73]).
820multiply_single(_63,_65,_67) :-
821        multiply_single__1(_69,_71,_73),
822        unify_sets([_63,_65,_67], [_69,_71,_73]).
823subtract_polynomials(_63,_65,_67) :-
824        subtract_polynomials__1(_69,_71,_73),
825        unify_sets([_63,_65,_67], [_69,_71,_73]).
826add_polynomials(_63,_65,_67) :-
827        add_polynomials__1(_69,_71,_73),
828        unify_sets([_63,_65,_67], [_69,_71,_73]).
829remove_zero_terms(_63,_65) :-
830        remove_zero_terms__1(_67,_69),
831        unify_sets([_63,_65], [_67,_69]).
832polynomial_form(_63,_65,_67) :-
833        polynomial_form__1(_69,_71,_73),
834        unify_sets([_63,_65,_67], [_69,_71,_73]).
835polynomial_normal_form(_63,_65,_67) :-
836        polynomial_normal_form__1(_69,_71,_73),
837        unify_sets([_63,_65,_67], [_69,_71,_73]).
838natural_number(_63) :-
839        natural_number__1(_65),
840        unify_sets([_63], [_65]).
841is_polynomial(_63,_65) :-
842        is_polynomial__1(_67,_69),
843        unify_sets([_63,_65], [_67,_69]).
844isolax(_63,_65,_67) :-
845        isolax__1(_69,_71,_73),
846        unify_sets([_63,_65,_67], [_69,_71,_73]).
847isolate(_63,_65,_67) :-
848        isolate__1(_69,_71,_73),
849        unify_sets([_63,_65,_67], [_69,_71,_73]).
850maneuver_sides(_63,_65,_67) :-
851        maneuver_sides__1(_69,_71,_73),
852        unify_sets([_63,_65,_67], [_69,_71,_73]).
853single_occurrence(_63,_65) :-
854        single_occurrence__1(_67,_69),
855        unify_sets([_63,_65], [_67,_69]).
856solve_factors(_63,_65,_67) :-
857        solve_factors__1(_69,_71,_73),
858        unify_sets([_63,_65,_67], [_69,_71,_73]).
859factorize(_63,_65,_67) :-
860        factorize__1(_69,_71,_73),
861        unify_sets([_63,_65,_67], [_69,_71,_73]).
862solve_equation(_63,_65,_67) :-
863        solve_equation__1(_69,_71,_73),
864        unify_sets([_63,_65,_67], [_69,_71,_73]).
865
866%---------------- Tp ---------------------------------------
867
868tp :- equation__1(_64,_66,_68), fail.
869tp :- test_press__1(_64,_66), fail.
870tp :- remove_duplicates__1(_64,_66), fail.
871tp :- multiple__1(_64), fail.
872tp :- occurrence__1(_64,_66,_68,_70,_72), fail.
873tp :- occurrence__1(_64,_66,_68), fail.
874tp :- free_of__1(_64,_66), fail.
875tp :- parse__1(_64,_66,_68), fail.
876tp :- position__1(_64,_66,_68,_70), fail.
877tp :- position__1(_64,_66,_68), fail.
878tp :- subterm__1(_64,_66,_68), fail.
879tp :- member__1(_64,_66), fail.
880tp :- constant__1(_64), fail.
881tp :- subterm__1(_64,_66), fail.
882tp :- homog_axiom__1(_64,_66,_68,_70), fail.
883tp :- rewrite__1(_64,_66,_68,_70), fail.
884tp :- substitute__1(_64,_66,_68), fail.
885tp :- polynomial_exponents__1(_64,_66), fail.
886tp :- base__1(_64,_66), fail.
887tp :- candidate__1(_64,_66,_68,_70), fail.
888tp :- exponential_offenders__1(_64,_66), fail.
889tp :- classify__1(_64,_66,_68), fail.
890tp :- reduced_term__1(_64,_66,_68,_70), fail.
891tp :- homogenize__1(_64,_66,_68,_70,_72), fail.
892tp :- offenders__1(_64,_66,_68), fail.
893tp :- quadratic__1(_64), fail.
894tp :- linear__1(_64), fail.
895tp :- pad__1(_64,_66), fail.
896tp :- root__1(_64,_66,_68,_70,_72,_74), fail.
897tp :- discriminant__1(_64,_66,_68,_70), fail.
898tp :- solve_polynomial_equation__1(_64,_66,_68), fail.
899tp :- binomial__1(_64,_66,_68), fail.
900tp :- multiply_polynomials__1(_64,_66,_68), fail.
901tp :- multiply_single__1(_64,_66,_68), fail.
902tp :- subtract_polynomials__1(_64,_66,_68), fail.
903tp :- add_polynomials__1(_64,_66,_68), fail.
904tp :- remove_zero_terms__1(_64,_66), fail.
905tp :- polynomial_form__1(_64,_66,_68), fail.
906tp :- polynomial_normal_form__1(_64,_66,_68), fail.
907tp :- natural_number__1(_64), fail.
908tp :- is_polynomial__1(_64,_66), fail.
909tp :- isolax__1(_64,_66,_68), fail.
910tp :- isolate__1(_64,_66,_68), fail.
911tp :- maneuver_sides__1(_64,_66,_68), fail.
912tp :- single_occurrence__1(_64,_66), fail.
913tp :- solve_factors__1(_64,_66,_68), fail.
914tp :- factorize__1(_64,_66,_68), fail.
915tp :- solve_equation__1(_64,_66,_68), fail.
916tp.
917
918
919%---------------- Builtin Preds ----------------------------
920
921'my ='(X1,X2) :- 'my =__1'(Y1,Y2), unify_sets([X1,X2],[Y1,Y2]).
922'my \\=='(X1,X2) :- 'my \\==__1'(Y1,Y2), unify_sets([X1,X2],[Y1,Y2]).
923'my is'(X1,X2) :- 'my is__1'(Y1,Y2), unify_sets([X1,X2],[Y1,Y2]).
924'my =:='(X1,X2) :- 'my =:=__1'(Y1,Y2), unify_sets([X1,X2],[Y1,Y2]).
925'my =\\='(X1,X2) :- 'my =\\=__1'(Y1,Y2), unify_sets([X1,X2],[Y1,Y2]).
926'my <'(X1,X2) :- 'my <__1'(Y1,Y2), unify_sets([X1,X2],[Y1,Y2]).
927'my >'(X1,X2) :- 'my >__1'(Y1,Y2), unify_sets([X1,X2],[Y1,Y2]).
928'my >='(X1,X2) :- 'my >=__1'(Y1,Y2), unify_sets([X1,X2],[Y1,Y2]).
929'my =<'(X1,X2) :- 'my =<__1'(Y1,Y2), unify_sets([X1,X2],[Y1,Y2]).
930
931'my =__1'(X,X).
932'my \\==__1'(_,_).
933'my is__1'(num,num).
934'my <__1'(num,num).
935'my >__1'(num,num).
936'my >=__1'(num,num).
937'my =<__1'(num,num).
938'my =:=__1'(num,num).
939'my =\\=__1'(num,num).
940
941
942%---------------- Show Result ------------------------------
943
944show_facts :- equation__1(_63,_65,_67),
945              numbervars([_63,_65,_67]),
946              write(equation(_63,_65,_67)), nl, fail.
947show_facts :- test_press__1(_63,_65),
948              numbervars([_63,_65]),
949              write(test_press(_63,_65)), nl, fail.
950show_facts :- remove_duplicates__1(_63,_65),
951              numbervars([_63,_65]),
952              write(remove_duplicates(_63,_65)), nl, fail.
953show_facts :- multiple__1(_63),
954              numbervars([_63]),
955              write(multiple(_63)), nl, fail.
956show_facts :- occurrence__1(_63,_65,_67,_69,_71),
957              numbervars([_63,_65,_67,_69,_71]),
958              write(occurrence(_63,_65,_67,_69,_71)), nl, fail.
959show_facts :- occurrence__1(_63,_65,_67),
960              numbervars([_63,_65,_67]),
961              write(occurrence(_63,_65,_67)), nl, fail.
962show_facts :- free_of__1(_63,_65),
963              numbervars([_63,_65]),
964              write(free_of(_63,_65)), nl, fail.
965show_facts :- parse__1(_63,_65,_67),
966              numbervars([_63,_65,_67]),
967              write(parse(_63,_65,_67)), nl, fail.
968show_facts :- position__1(_63,_65,_67,_69),
969              numbervars([_63,_65,_67,_69]),
970              write(position(_63,_65,_67,_69)), nl, fail.
971show_facts :- position__1(_63,_65,_67),
972              numbervars([_63,_65,_67]),
973              write(position(_63,_65,_67)), nl, fail.
974show_facts :- subterm__1(_63,_65,_67),
975              numbervars([_63,_65,_67]),
976              write(subterm(_63,_65,_67)), nl, fail.
977show_facts :- member__1(_63,_65),
978              numbervars([_63,_65]),
979              write(member(_63,_65)), nl, fail.
980show_facts :- constant__1(_63),
981              numbervars([_63]),
982              write(constant(_63)), nl, fail.
983show_facts :- subterm__1(_63,_65),
984              numbervars([_63,_65]),
985              write(subterm(_63,_65)), nl, fail.
986show_facts :- homog_axiom__1(_63,_65,_67,_69),
987              numbervars([_63,_65,_67,_69]),
988              write(homog_axiom(_63,_65,_67,_69)), nl, fail.
989show_facts :- rewrite__1(_63,_65,_67,_69),
990              numbervars([_63,_65,_67,_69]),
991              write(rewrite(_63,_65,_67,_69)), nl, fail.
992show_facts :- substitute__1(_63,_65,_67),
993              numbervars([_63,_65,_67]),
994              write(substitute(_63,_65,_67)), nl, fail.
995show_facts :- polynomial_exponents__1(_63,_65),
996              numbervars([_63,_65]),
997              write(polynomial_exponents(_63,_65)), nl, fail.
998show_facts :- base__1(_63,_65),
999              numbervars([_63,_65]),
1000              write(base(_63,_65)), nl, fail.
1001show_facts :- candidate__1(_63,_65,_67,_69),
1002              numbervars([_63,_65,_67,_69]),
1003              write(candidate(_63,_65,_67,_69)), nl, fail.
1004show_facts :- exponential_offenders__1(_63,_65),
1005              numbervars([_63,_65]),
1006              write(exponential_offenders(_63,_65)), nl, fail.
1007show_facts :- classify__1(_63,_65,_67),
1008              numbervars([_63,_65,_67]),
1009              write(classify(_63,_65,_67)), nl, fail.
1010show_facts :- reduced_term__1(_63,_65,_67,_69),
1011              numbervars([_63,_65,_67,_69]),
1012              write(reduced_term(_63,_65,_67,_69)), nl, fail.
1013show_facts :- homogenize__1(_63,_65,_67,_69,_71),
1014              numbervars([_63,_65,_67,_69,_71]),
1015              write(homogenize(_63,_65,_67,_69,_71)), nl, fail.
1016show_facts :- offenders__1(_63,_65,_67),
1017              numbervars([_63,_65,_67]),
1018              write(offenders(_63,_65,_67)), nl, fail.
1019show_facts :- quadratic__1(_63),
1020              numbervars([_63]),
1021              write(quadratic(_63)), nl, fail.
1022show_facts :- linear__1(_63),
1023              numbervars([_63]),
1024              write(linear(_63)), nl, fail.
1025show_facts :- pad__1(_63,_65),
1026              numbervars([_63,_65]),
1027              write(pad(_63,_65)), nl, fail.
1028show_facts :- root__1(_63,_65,_67,_69,_71,_73),
1029              numbervars([_63,_65,_67,_69,_71,_73]),
1030              write(root(_63,_65,_67,_69,_71,_73)), nl, fail.
1031show_facts :- discriminant__1(_63,_65,_67,_69),
1032              numbervars([_63,_65,_67,_69]),
1033              write(discriminant(_63,_65,_67,_69)), nl, fail.
1034show_facts :- solve_polynomial_equation__1(_63,_65,_67),
1035              numbervars([_63,_65,_67]),
1036              write(solve_polynomial_equation(_63,_65,_67)), nl, fail.
1037show_facts :- binomial__1(_63,_65,_67),
1038              numbervars([_63,_65,_67]),
1039              write(binomial(_63,_65,_67)), nl, fail.
1040show_facts :- multiply_polynomials__1(_63,_65,_67),
1041              numbervars([_63,_65,_67]),
1042              write(multiply_polynomials(_63,_65,_67)), nl, fail.
1043show_facts :- multiply_single__1(_63,_65,_67),
1044              numbervars([_63,_65,_67]),
1045              write(multiply_single(_63,_65,_67)), nl, fail.
1046show_facts :- subtract_polynomials__1(_63,_65,_67),
1047              numbervars([_63,_65,_67]),
1048              write(subtract_polynomials(_63,_65,_67)), nl, fail.
1049show_facts :- add_polynomials__1(_63,_65,_67),
1050              numbervars([_63,_65,_67]),
1051              write(add_polynomials(_63,_65,_67)), nl, fail.
1052show_facts :- remove_zero_terms__1(_63,_65),
1053              numbervars([_63,_65]),
1054              write(remove_zero_terms(_63,_65)), nl, fail.
1055show_facts :- polynomial_form__1(_63,_65,_67),
1056              numbervars([_63,_65,_67]),
1057              write(polynomial_form(_63,_65,_67)), nl, fail.
1058show_facts :- polynomial_normal_form__1(_63,_65,_67),
1059              numbervars([_63,_65,_67]),
1060              write(polynomial_normal_form(_63,_65,_67)), nl, fail.
1061show_facts :- natural_number__1(_63),
1062              numbervars([_63]),
1063              write(natural_number(_63)), nl, fail.
1064show_facts :- is_polynomial__1(_63,_65),
1065              numbervars([_63,_65]),
1066              write(is_polynomial(_63,_65)), nl, fail.
1067show_facts :- isolax__1(_63,_65,_67),
1068              numbervars([_63,_65,_67]),
1069              write(isolax(_63,_65,_67)), nl, fail.
1070show_facts :- isolate__1(_63,_65,_67),
1071              numbervars([_63,_65,_67]),
1072              write(isolate(_63,_65,_67)), nl, fail.
1073show_facts :- maneuver_sides__1(_63,_65,_67),
1074              numbervars([_63,_65,_67]),
1075              write(maneuver_sides(_63,_65,_67)), nl, fail.
1076show_facts :- single_occurrence__1(_63,_65),
1077              numbervars([_63,_65]),
1078              write(single_occurrence(_63,_65)), nl, fail.
1079show_facts :- solve_factors__1(_63,_65,_67),
1080              numbervars([_63,_65,_67]),
1081              write(solve_factors(_63,_65,_67)), nl, fail.
1082show_facts :- factorize__1(_63,_65,_67),
1083              numbervars([_63,_65,_67]),
1084              write(factorize(_63,_65,_67)), nl, fail.
1085show_facts :- solve_equation__1(_63,_65,_67),
1086              numbervars([_63,_65,_67]),
1087              write(solve_equation(_63,_65,_67)), nl, fail.
1088show_facts.
1089