Annotation of OpenXM_contrib/PHC/Ada/Main/driver_for_root_counts.adb, Revision 1.1
1.1 ! maekawa 1: with integer_io; use integer_io;
! 2: with Communications_with_User; use Communications_with_User;
! 3: with Timing_Package; use Timing_Package;
! 4: with Standard_Complex_Polynomials; use Standard_Complex_Polynomials;
! 5: with Standard_Complex_Poly_Systems_io; use Standard_Complex_Poly_Systems_io;
! 6: with Standard_Complex_Solutions; use Standard_Complex_Solutions;
! 7: with Standard_Complex_Solutions_io; use Standard_Complex_Solutions_io;
! 8:
! 9: with m_Homogeneous_Bezout_Numbers; use m_Homogeneous_Bezout_Numbers;
! 10: with Total_Degree_Start_Systems; use Total_Degree_Start_Systems;
! 11: with Lists_of_Integer_Vectors; use Lists_of_Integer_Vectors;
! 12: with Driver_for_Own_Start_System;
! 13: with Drivers_for_m_Homogenization; use Drivers_for_m_Homogenization;
! 14: with Drivers_for_Multi_Homogenization; use Drivers_for_Multi_Homogenization;
! 15: with Drivers_for_Set_Structures; use Drivers_for_Set_Structures;
! 16: with Driver_for_Symmetric_Set_Structure; use Driver_for_Symmetric_Set_Structure;
! 17:
! 18: with Drivers_for_Implicit_Lifting; use Drivers_for_Implicit_Lifting;
! 19: with Drivers_for_Static_Lifting; use Drivers_for_Static_Lifting;
! 20: with Drivers_for_Dynamic_Lifting; use Drivers_for_Dynamic_Lifting;
! 21: with Drivers_for_Symmetric_Lifting; use Drivers_for_Symmetric_Lifting;
! 22:
! 23: procedure Driver_for_Root_Counts
! 24: ( file : in file_type; p,q : in out Poly_Sys;
! 25: own : in boolean;
! 26: qsols : in out Solution_List; roco : out natural ) is
! 27:
! 28: timer : timing_widget;
! 29: rc : natural := Total_Degree(p);
! 30: lpos : List;
! 31: choice : string(1..2) := " ";
! 32: method,ans : character := 'y';
! 33: noqsols : natural := 0;
! 34:
! 35: procedure High_Total_Degree is
! 36: begin
! 37: for i in p'range loop
! 38: put(Degree(p(i)),1); put(file,Degree(p(i)),1);
! 39: exit when i = p'last;
! 40: put("*"); put(file,"*");
! 41: end loop;
! 42: new_line;
! 43: put_line(" this is higher than my largest integer. Be careful...");
! 44: end High_Total_Degree;
! 45:
! 46: procedure Display_Menu ( rc : in natural ) is
! 47:
! 48: m : array(0..9) of string(1..66);
! 49:
! 50: begin
! 51: new_line;
! 52: put_line("MENU with ROOT COUNTS and Methods to Construct START SYSTEMS :");
! 53: put(" 0. exit - current start system is ");
! 54: if Is_Null(qsols)
! 55: then put("based on total degree : "); put(rc,1); new_line;
! 56: else case method is
! 57: when '1' => put("based on multi-homogenization : ");
! 58: when '2' => put("based on partitioned linear-product : ");
! 59: when '3' => put("based on set structure : ");
! 60: when '4' => put("based on symmetric set structure : ");
! 61: when '5' => put("based on Bezout and BKK Bound : ");
! 62: when '6' => put("based on static mixed-volume computation : ");
! 63: when '7' => put("based on dynamic mixed-volume computation : ");
! 64: when '8' => put("based on symmetric mixed-volume computation : ");
! 65: when '9' => put("your start system : ");
! 66: when others => put("based on total degree");
! 67: end case;
! 68: put(rc,1); new_line;
! 69: end if;
! 70: m(0):="PRODUCT HOMOTOPIES based on DEGREES ------------------------------";
! 71: m(1):=" 1. multi-homogeneous Bezout number (one partition)";
! 72: m(2):=" 2. partitioned linear-product Bezout number (many partitions)";
! 73: m(3):=" 3. general linear-product Bezout number (set structure)";
! 74: m(4):=" 4. symmetric general linear-product Bezout number (group action)";
! 75: m(5):="POLYHEDRAL HOMOTOPIES based on NEWTON POLYTOPES ------------------";
! 76: m(6):=" 5. combination between Bezout and BKK Bound (implicit lifting)";
! 77: m(7):=" 6. mixed-volume computation (static lifting)";
! 78: m(8):=" 7. incremental mixed-volume computation (dynamic lifting)";
! 79: m(9):=" 8. symmetric mixed-volume computation (symmetric lifting)";
! 80: for i in m'range loop
! 81: put_line(m(i));
! 82: end loop;
! 83: if own
! 84: then put_line
! 85: ("START SYSTEM DEFINED BY USER -------------------------------------");
! 86: put_line(" 9. you can give your own start system");
! 87: else put_line
! 88: ("------------------------------------------------------------------");
! 89: end if;
! 90: end Display_Menu;
! 91:
! 92: procedure Display_Info ( method : character ) is
! 93:
! 94: -- DESCRIPTION :
! 95: -- Displays the information that corresponds with the current method.
! 96:
! 97: begin
! 98: new_line;
! 99: case method is
! 100: when '0' => Total_Degree_Info;
! 101: when '1' => m_Homogenization_Info;
! 102: when '2' => Multi_Homogenization_Info;
! 103: when '3' => Set_Structure_Info;
! 104: when '4' => Symmetric_Set_Structure_Info;
! 105: when '5' => Implicit_Lifting_Info;
! 106: when '6' => Static_Lifting_Info;
! 107: when '7' => Dynamic_Lifting_Info;
! 108: when '8' => Symmetric_Lifting_Info;
! 109: when others => put_line("No information available.");
! 110: end case;
! 111: new_line;
! 112: end Display_Info;
! 113:
! 114: procedure Apply_Method ( method : character ) is
! 115:
! 116: -- DESCRIPTION :
! 117: -- Applies the root count that corresponds with the current method.
! 118:
! 119: begin
! 120: case method is
! 121: when '0' => Start_System(p,q,qsols);
! 122: when '1' => Driver_for_m_Homogenization(file,p,rc,q,qsols);
! 123: when '2' => Driver_for_Multi_Homogenization(file,p,rc,q,qsols);
! 124: when '3' => Driver_for_Set_Structure(file,p,rc,lpos,q,qsols);
! 125: when '4' => Driver_for_Symmetric_Random_Product_Systems
! 126: (file,p,q,qsols,rc,lpos);
! 127: when '5' => Driver_for_Mixture_Bezout_BKK(file,p,false,q,qsols,rc);
! 128: when '6' => Driver_for_Mixed_Volume_Computation(file,p,false,q,qsols,rc);
! 129: when '7' => Driver_for_Dynamic_Mixed_Volume_Computation
! 130: (file,p,false,q,qsols,rc);
! 131: when '8' => Driver_for_Symmetric_Mixed_Volume_Computation
! 132: (file,p,false,q,qsols,rc);
! 133: when '9' => Driver_for_Own_Start_System(file,p,q,qsols);
! 134: when others => null;
! 135: end case;
! 136: end Apply_Method;
! 137:
! 138: begin
! 139: new_line(file); put_line(file,"ROOT COUNTS :"); new_line(file);
! 140: put(file,"total degree : ");
! 141: if rc > 0
! 142: then put(file,rc,1); -- put(rc,1);
! 143: else High_Total_Degree;
! 144: end if;
! 145: new_line(file);
! 146: loop
! 147: Display_Menu(rc);
! 148: if own
! 149: then put("Type a number between 0 and 9,"
! 150: & " eventually preceded by i for info : ");
! 151: Ask_Alternative(choice,"0123456789",'i');
! 152: else put("Type a number between 0 and 8,"
! 153: & " eventually preceded by i for info : ");
! 154: Ask_Alternative(choice,"012345678",'i');
! 155: end if;
! 156: if choice(1) = 'i'
! 157: then method := choice(2);
! 158: Display_Info(method);
! 159: put("Do you want to apply this root count ? (y/n) ");
! 160: Ask_Yes_or_No(ans);
! 161: else method := choice(1);
! 162: end if;
! 163: if ans = 'y'
! 164: then Apply_Method(method);
! 165: noqsols := Length_Of(qsols);
! 166: if method /= '0'
! 167: then new_line;
! 168: put("The current root count equals "); put(rc,1); put_line(".");
! 169: if noqsols /= 0
! 170: then put("The number of start solutions equals ");
! 171: put(noqsols,1); put_line(".");
! 172: end if;
! 173: put("Do you want to perform more root counting ? (y/n) ");
! 174: Ask_Yes_or_No(ans);
! 175: else ans := 'n';
! 176: end if;
! 177: else ans := 'y';
! 178: end if;
! 179: exit when ans /= 'y';
! 180: end loop;
! 181: roco := rc;
! 182: Clear(lpos);
! 183: end Driver_for_Root_Counts;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>