![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to permute_operations.adb CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM_contrib / PHC / Ada / Root_Counts / Symmetry|
Return to permute_operations.adb CVS log | Up to [local] / OpenXM_contrib / PHC / Ada / Root_Counts / Symmetry |
1.1 ! maekawa 1: with Standard_Complex_Numbers; use Standard_Complex_Numbers;
! 2:
! 3: package body Permute_Operations is
! 4:
! 5: function "*" ( p : Permutation; v : Standard_Natural_Vectors.Vector )
! 6: return Standard_Natural_Vectors.Vector is
! 7:
! 8: r : Standard_Natural_Vectors.Vector(v'range);
! 9:
! 10: begin
! 11: for i in p'range loop
! 12: if p(i) >= 0
! 13: then r(i) := v(p(i));
! 14: else r(i) := -v(-p(i));
! 15: end if;
! 16: end loop;
! 17: return r;
! 18: end "*";
! 19:
! 20: function "*" ( p : Permutation; v : Standard_Integer_Vectors.Vector )
! 21: return Standard_Integer_Vectors.Vector is
! 22:
! 23: r : Standard_Integer_Vectors.Vector(v'range);
! 24:
! 25: begin
! 26: for i in p'range loop
! 27: if p(i) >= 0
! 28: then r(i) := v(p(i));
! 29: else r(i) := -v(-p(i));
! 30: end if;
! 31: end loop;
! 32: return r;
! 33: end "*";
! 34:
! 35: function "*" ( p : Permutation; v : Standard_Floating_Vectors.Vector )
! 36: return Standard_Floating_Vectors.Vector is
! 37:
! 38: r : Standard_Floating_Vectors.Vector(v'range);
! 39:
! 40: begin
! 41: for i in p'range loop
! 42: if p(i) >= 0
! 43: then r(i) := v(p(i));
! 44: else r(i) := -v(-p(i));
! 45: end if;
! 46: end loop;
! 47: return r;
! 48: end "*";
! 49:
! 50: function "*" ( p : Permutation; v : Standard_Complex_Vectors.Vector )
! 51: return Standard_Complex_Vectors.Vector is
! 52:
! 53: r : Standard_Complex_Vectors.Vector(v'range);
! 54:
! 55: begin
! 56: for i in p'range loop
! 57: if p(i) >= 0
! 58: then r(i) := v(p(i));
! 59: else r(i) := -v(-p(i));
! 60: end if;
! 61: end loop;
! 62: return r;
! 63: end "*";
! 64:
! 65: function Permutable ( v1,v2 : Standard_Natural_Vectors.Vector )
! 66: return boolean is
! 67: begin
! 68: if v1'first /= v2'first or else v1'last /= v2'last
! 69: then return false; -- the dimensions must correspond !
! 70: else declare
! 71: p : Permutation(v1'first..v1'last);
! 72: begin
! 73: for k in p'range loop
! 74: p(k) := 0;
! 75: for l in v2'range loop
! 76: if v2(l) = v1(k)
! 77: then p(k) := l;
! 78: for j in 1..(k-1) loop
! 79: if p(j) = l
! 80: then p(k) := 0;
! 81: end if;
! 82: end loop;
! 83: end if;
! 84: exit when p(k) /= 0;
! 85: end loop;
! 86: if p(k) = 0
! 87: then return false;
! 88: end if;
! 89: end loop;
! 90: end;
! 91: return true;
! 92: end if;
! 93: end Permutable;
! 94:
! 95: function Permutable ( v1,v2 : Standard_Integer_Vectors.Vector )
! 96: return boolean is
! 97: begin
! 98: if v1'first /= v2'first or else v1'last /= v2'last
! 99: then return false; -- the dimensions must correspond !
! 100: else declare
! 101: p : Permutation(v1'first..v1'last);
! 102: begin
! 103: for k in p'range loop
! 104: p(k) := 0;
! 105: for l in v2'range loop
! 106: if v2(l) = v1(k)
! 107: then p(k) := l;
! 108: for j in 1..(k-1) loop
! 109: if p(j) = l
! 110: then p(k) := 0;
! 111: end if;
! 112: end loop;
! 113: end if;
! 114: exit when p(k) /= 0;
! 115: end loop;
! 116: if p(k) = 0
! 117: then return false;
! 118: end if;
! 119: end loop;
! 120: end;
! 121: return true;
! 122: end if;
! 123: end Permutable;
! 124:
! 125: function Permutable ( v1,v2 : Standard_Floating_Vectors.Vector )
! 126: return boolean is
! 127: begin
! 128: if v1'first /= v2'first or else v1'last /= v2'last
! 129: then return false; -- the dimensions must correspond !
! 130: else declare
! 131: p : Permutation(v1'first..v1'last);
! 132: begin
! 133: for k in p'range loop
! 134: p(k) := 0;
! 135: for l in v2'range loop
! 136: if v2(l) = v1(k)
! 137: then p(k) := l;
! 138: for j in 1..(k-1) loop
! 139: if p(j) = l
! 140: then p(k) := 0;
! 141: end if;
! 142: end loop;
! 143: end if;
! 144: exit when p(k) /= 0;
! 145: end loop;
! 146: if p(k) = 0
! 147: then return false;
! 148: end if;
! 149: end loop;
! 150: end;
! 151: return true;
! 152: end if;
! 153: end Permutable;
! 154:
! 155: function Permutable ( v1,v2 : Standard_Complex_Vectors.Vector )
! 156: return boolean is
! 157: begin
! 158: if v1'first /= v2'first or else v1'last /= v2'last
! 159: then return false; -- the dimensions must correspond !
! 160: else declare
! 161: p : Permutation(v1'first..v1'last);
! 162: begin
! 163: for k in p'range loop
! 164: p(k) := 0;
! 165: for l in v2'range loop
! 166: if v2(l) = v1(k)
! 167: then p(k) := l;
! 168: for j in 1..(k-1) loop
! 169: if p(j) = l
! 170: then p(k) := 0;
! 171: end if;
! 172: end loop;
! 173: end if;
! 174: exit when p(k) /= 0;
! 175: end loop;
! 176: if p(k) = 0
! 177: then return false;
! 178: end if;
! 179: end loop;
! 180: end;
! 181: return true;
! 182: end if;
! 183: end Permutable;
! 184:
! 185: function Permutable ( v1,v2 : Standard_Floating_Vectors.Vector;
! 186: tol : double_float ) return boolean is
! 187: begin
! 188: if v1'first /= v2'first or else v1'last /= v2'last
! 189: then return false; -- the dimensions must correspond !
! 190: else declare
! 191: p : Permutation(v1'first..v1'last);
! 192: begin
! 193: for k in p'range loop
! 194: p(k) := 0;
! 195: for l in v2'range loop
! 196: if ABS(v2(l) - v1(k)) <= tol
! 197: then p(k) := l;
! 198: for j in 1..(k-1) loop
! 199: if p(j) = l
! 200: then p(k) := 0;
! 201: end if;
! 202: end loop;
! 203: end if;
! 204: exit when p(k) /= 0;
! 205: end loop;
! 206: if p(k) = 0
! 207: then return false;
! 208: end if;
! 209: end loop;
! 210: end;
! 211: return true;
! 212: end if;
! 213: end Permutable;
! 214:
! 215: function Permutable ( v1,v2 : Standard_Complex_Vectors.Vector;
! 216: tol : double_float ) return boolean is
! 217: begin
! 218: if v1'first /= v2'first or else v1'last /= v2'last
! 219: then return false; -- the dimensions must correspond !
! 220: else declare
! 221: p : Permutation(v1'first..v1'last);
! 222: begin
! 223: for k in p'range loop
! 224: p(k) := 0;
! 225: for l in v2'range loop
! 226: if (ABS(REAL_PART(v2(l)) - REAL_PART(v1(k))) <= tol)
! 227: and then (ABS(IMAG_PART(v2(l)) - IMAG_PART(v1(k))) <= tol)
! 228: then p(k) := l;
! 229: for j in 1..(k-1) loop
! 230: if p(j) = l
! 231: then p(k) := 0;
! 232: end if;
! 233: end loop;
! 234: end if;
! 235: exit when p(k) /= 0;
! 236: end loop;
! 237: if p(k) = 0
! 238: then return false;
! 239: end if;
! 240: end loop;
! 241: end;
! 242: return true;
! 243: end if;
! 244: end Permutable;
! 245:
! 246: function Sign_Permutable ( v1,v2 : Standard_Natural_Vectors.Vector )
! 247: return boolean is
! 248: begin
! 249: if v1'first /= v2'first or else v1'last /= v2'last
! 250: then return false; -- the dimensions must correspond !
! 251: else declare
! 252: p : Permutation(v1'first..v1'last);
! 253: begin
! 254: for k in p'range loop
! 255: p(k) := 0;
! 256: for l in v2'range loop
! 257: if v2(l) = v1(k) or else v2(l) = -v1(k)
! 258: then p(k) := l;
! 259: for j in 1..(k-1) loop
! 260: if p(j) = l
! 261: then p(k) := 0;
! 262: end if;
! 263: end loop;
! 264: end if;
! 265: exit when p(k) /= 0;
! 266: end loop;
! 267: if p(k) = 0
! 268: then return false;
! 269: end if;
! 270: end loop;
! 271: end;
! 272: return true;
! 273: end if;
! 274: end Sign_Permutable;
! 275:
! 276: function Sign_Permutable ( v1,v2 : Standard_Integer_Vectors.Vector )
! 277: return boolean is
! 278: begin
! 279: if v1'first /= v2'first or else v1'last /= v2'last
! 280: then return false; -- the dimensions must correspond !
! 281: else declare
! 282: p : Permutation(v1'first..v1'last);
! 283: begin
! 284: for k in p'range loop
! 285: p(k) := 0;
! 286: for l in v2'range loop
! 287: if v2(l) = v1(k) or else v2(l) = -v1(k)
! 288: then p(k) := l;
! 289: for j in 1..(k-1) loop
! 290: if p(j) = l
! 291: then p(k) := 0;
! 292: end if;
! 293: end loop;
! 294: end if;
! 295: exit when p(k) /= 0;
! 296: end loop;
! 297: if p(k) = 0
! 298: then return false;
! 299: end if;
! 300: end loop;
! 301: end;
! 302: return true;
! 303: end if;
! 304: end Sign_Permutable;
! 305:
! 306: function Sign_Permutable ( v1,v2 : Standard_Floating_Vectors.Vector )
! 307: return boolean is
! 308: begin
! 309: if v1'first /= v2'first or else v1'last /= v2'last
! 310: then return false; -- the dimensions must correspond !
! 311: else declare
! 312: p : Permutation(v1'first..v1'last);
! 313: begin
! 314: for k in p'range loop
! 315: p(k) := 0;
! 316: for l in v2'range loop
! 317: if v2(l) = v1(k) or else v2(l) = -v1(k)
! 318: then p(k) := l;
! 319: for j in 1..(k-1) loop
! 320: if p(j) = l
! 321: then p(k) := 0;
! 322: end if;
! 323: end loop;
! 324: end if;
! 325: exit when p(k) /= 0;
! 326: end loop;
! 327: if p(k) = 0
! 328: then return false;
! 329: end if;
! 330: end loop;
! 331: end;
! 332: return true;
! 333: end if;
! 334: end Sign_Permutable;
! 335:
! 336: function Sign_Permutable ( v1,v2 : Standard_Complex_Vectors.Vector )
! 337: return boolean is
! 338: begin
! 339: if v1'first /= v2'first or else v1'last /= v2'last
! 340: then return false; -- the dimensions must correspond !
! 341: else declare
! 342: p : Permutation(v1'first..v1'last);
! 343: begin
! 344: for k in p'range loop
! 345: p(k) := 0;
! 346: for l in v2'range loop
! 347: if v2(l) = v1(k) or else v2(l) = -v1(k)
! 348: then p(k) := l;
! 349: for j in 1..(k-1) loop
! 350: if p(j) = l
! 351: then p(k) := 0;
! 352: end if;
! 353: end loop;
! 354: end if;
! 355: exit when p(k) /= 0;
! 356: end loop;
! 357: if p(k) = 0
! 358: then return false;
! 359: end if;
! 360: end loop;
! 361: end;
! 362: return true;
! 363: end if;
! 364: end Sign_Permutable;
! 365:
! 366: function Sign_Permutable ( v1,v2 : Standard_Floating_Vectors.Vector;
! 367: tol : double_float ) return boolean is
! 368: begin
! 369: if v1'first /= v2'first or else v1'last /= v2'last
! 370: then return false; -- the dimensions must correspond !
! 371: else declare
! 372: p : Permutation(v1'first..v1'last);
! 373: begin
! 374: for k in p'range loop
! 375: p(k) := 0;
! 376: for l in v2'range loop
! 377: if (ABS(v2(l) - v1(k)) <= tol)
! 378: or else (ABS(v2(l) + v1(k)) <= tol)
! 379: then p(k) := l;
! 380: for j in 1..(k-1) loop
! 381: if p(j) = l
! 382: then p(k) := 0;
! 383: end if;
! 384: end loop;
! 385: end if;
! 386: exit when p(k) /= 0;
! 387: end loop;
! 388: if p(k) = 0
! 389: then return false;
! 390: end if;
! 391: end loop;
! 392: end;
! 393: return true;
! 394: end if;
! 395: end Sign_Permutable;
! 396:
! 397: function Sign_Permutable ( v1,v2 : Standard_Complex_Vectors.Vector;
! 398: tol : double_float ) return boolean is
! 399: begin
! 400: if v1'first /= v2'first or else v1'last /= v2'last
! 401: then return false; -- the dimensions must correspond !
! 402: else declare
! 403: p : Permutation(v1'first..v1'last);
! 404: begin
! 405: for k in p'range loop
! 406: p(k) := 0;
! 407: for l in v2'range loop
! 408: if ((ABS(REAL_PART(v2(l)) - REAL_PART(v1(k))) <= tol)
! 409: and then (ABS(IMAG_PART(v2(l)) - IMAG_PART(v1(k))) <= tol))
! 410: or else ((ABS(REAL_PART(v2(l)) + REAL_PART(v1(k))) <= tol)
! 411: and then (ABS(IMAG_PART(v2(l)) + IMAG_PART(v1(k))) <= tol))
! 412: then p(k) := l;
! 413: for j in 1..(k-1) loop
! 414: if p(j) = l
! 415: then p(k) := 0;
! 416: end if;
! 417: end loop;
! 418: end if;
! 419: exit when p(k) /= 0;
! 420: end loop;
! 421: if p(k) = 0
! 422: then return false;
! 423: end if;
! 424: end loop;
! 425: end;
! 426: return true;
! 427: end if;
! 428: end Sign_Permutable;
! 429:
! 430: function "*" ( p : Permutation; t : Standard_Complex_Polynomials.Term )
! 431: return Standard_Complex_Polynomials.Term is
! 432:
! 433: res : Standard_Complex_Polynomials.Term;
! 434:
! 435: begin
! 436: res.cf := t.cf;
! 437: res.dg := new Standard_Natural_Vectors.Vector(t.dg'range);
! 438: for i in p'range loop
! 439: if p(i) >= 0
! 440: then res.dg(i) := t.dg(p(i));
! 441: else res.dg(i) := t.dg(-p(i));
! 442: res.cf := -res.cf;
! 443: end if;
! 444: end loop;
! 445: return res;
! 446: end "*";
! 447:
! 448: function "*" ( p : Permutation; s : Standard_Complex_Polynomials.Poly )
! 449: return Standard_Complex_Polynomials.Poly is
! 450:
! 451: use Standard_Complex_Polynomials;
! 452: res : Poly := Null_Poly;
! 453:
! 454: procedure Permute_Term ( t : in Term; continue : out boolean ) is
! 455: tt : Term := p*t;
! 456: begin
! 457: Add(res,tt);
! 458: Clear(tt);
! 459: continue := true;
! 460: end Permute_Term;
! 461: procedure Permute_Terms is new Visiting_Iterator(Permute_Term);
! 462:
! 463: begin
! 464: Permute_Terms(s);
! 465: return res;
! 466: end "*";
! 467:
! 468: function "*" ( p : Permutation; t : Standard_Complex_Laur_Polys.Term )
! 469: return Standard_Complex_Laur_Polys.Term is
! 470:
! 471: res : Standard_Complex_Laur_Polys.Term;
! 472:
! 473: begin
! 474: res.cf := t.cf;
! 475: res.dg := new Standard_Integer_Vectors.Vector(t.dg'range);
! 476: for i in p'range loop
! 477: if p(i) >= 0
! 478: then res.dg(i) := t.dg(p(i));
! 479: else res.dg(i) := t.dg(-p(i));
! 480: res.cf := -res.cf;
! 481: end if;
! 482: end loop;
! 483: return res;
! 484: end "*";
! 485:
! 486: function "*" ( p : Permutation; s : Standard_Complex_Laur_Polys.Poly )
! 487: return Standard_Complex_Laur_Polys.Poly is
! 488:
! 489: use Standard_Complex_Laur_Polys;
! 490: res : Poly := Null_Poly;
! 491:
! 492: procedure Permute_Term ( t : in Term; continue : out boolean ) is
! 493:
! 494: tt : Term := p*t;
! 495:
! 496: begin
! 497: Add(res,tt);
! 498: Clear(tt);
! 499: continue := true;
! 500: end Permute_Term;
! 501: procedure Permute_Terms is new Visiting_Iterator(Permute_Term);
! 502:
! 503: begin
! 504: Permute_Terms(s);
! 505: return res;
! 506: end "*";
! 507:
! 508: function "*" ( s : Poly_Sys; p : Permutation ) return Poly_Sys is
! 509:
! 510: res : Poly_Sys(s'range);
! 511:
! 512: begin
! 513: for k in res'range loop
! 514: res(k) := p*s(k);
! 515: end loop;
! 516: return res;
! 517: end "*";
! 518:
! 519: function "*" ( s : Laur_Sys; p : Permutation ) return Laur_Sys is
! 520:
! 521: res : Laur_Sys(s'range);
! 522:
! 523: begin
! 524: for k in res'range loop
! 525: res(k) := p*s(k);
! 526: end loop;
! 527: return res;
! 528: end "*";
! 529:
! 530: function "*" ( p : Permutation; s : Poly_Sys ) return Poly_Sys is
! 531:
! 532: r : Poly_Sys(s'range);
! 533: use Standard_Complex_Polynomials;
! 534:
! 535: begin
! 536: for i in p'range loop
! 537: if p(i) >= 0
! 538: then Copy(s(p(i)),r(i));
! 539: else r(i) := -s(-p(i));
! 540: end if;
! 541: end loop;
! 542: return r;
! 543: end "*";
! 544:
! 545: function "*" ( p : Permutation; s : Laur_Sys ) return Laur_Sys is
! 546:
! 547: r : Laur_Sys(s'range);
! 548: use Standard_Complex_Laur_Polys;
! 549:
! 550: begin
! 551: for i in p'range loop
! 552: if p(i) >= 0
! 553: then Copy(s(p(i)),r(i));
! 554: else r(i) := -s(-p(i));
! 555: end if;
! 556: end loop;
! 557: return r;
! 558: end "*";
! 559:
! 560: end Permute_Operations;