稳定婚姻的求解程序——Ada应用实例之一

本文介绍了一个使用Ada语言实现的稳定婚姻问题解决方案。通过定义特定的数据类型和数组,确保了程序的健壮性和类型安全性。该方案包括主程序、包规范及包体三部分。

摘要生成于 C知道 ,由 DeepSeek-R1 满血版支持, 前往体验 >

稳定婚姻的求解程序——Ada应用实例之一

 

一网友用C编写了稳定婚姻的求解程序,详见:

http://topic.youkuaiyun.com/u/20090904/07/c2aae375-c195-4ee1-b547-409688a520a4.html)。

该程序的求解思路是对的,但可惜没有正确处理数组下标,因此不能产生预期结果。

 

如果使用Ada,只要适当地定义了数组分量和下标的类型,那么在编译期间就可以发现和解决下标问题。

对于稳定婚姻的求解,我们定义如下数据类型:

 

   MAX_COUPLE_NUMBER : constant := 4;  --配偶数量

   type boy_id_type is new Natural range 0 .. MAX_COUPLE_NUMBER;

  --男孩编号,0是空号,有效编号从1开始

   type girl_id_type is new Positive range 1 .. MAX_COUPLE_NUMBER;

      --女孩编号,从1开始

   type favorite_index_type is new Positive range 1 .. MAX_COUPLE_NUMBER;

   type boy_favorite_list_type is array   --男孩所喜欢的女孩

     (boy_id_type range 1 .. boy_id_type'Last,

      favorite_index_type) of girl_id_type;

   type girl_favorite_list_type is array  --女孩所喜欢的男孩

     (girl_id_type, favorite_index_type) of boy_id_type;

   type boy_spouse_list_type is array     --男孩所配对的女孩

     (boy_id_type range 1 .. boy_id_type'Last) of girl_id_type;

这里boy_favorite_list_type是一个二维数组类型,它的两个下标的类型分别是boy_id_typefavorite_index_type,它的分量类型是girl_id_type。因此,该数组用于存放每个男孩所喜欢的女孩。

boy_id_typegirl_id_typefavorite_index_type是三个不同的类型,虽然后两个都是从Positive导出的,但这三个类型不能混用(除非进行强制类型转换)。例如,不能把类型为girl_id_type的变量用作类型为boy_favorite_list_type的数组的下标。同样,也不能把类型为boy_id_type的变量赋给类型为boy_favorite_list_type的数组的分量。

 

以下是整个求解程序,由三个Ada程序文件组成。

 

文件1stable_marrige.adb(主程序)

with Ada.Text_IO;

use Ada.Text_IO;

with stable_marrige_match;

use stable_marrige_match;

 

procedure stable_marrige is

   boy_favorite_list : constant boy_favorite_list_type :=

      ((2, 4, 1, 3), (3, 1, 4, 2), (2, 3, 1, 4), (4, 1, 3, 2));

   girl_favorite_list : constant girl_favorite_list_type :=

      ((2, 1, 4, 3), (4, 3, 1, 2), (1, 4, 3, 2), (2, 1, 4, 3));

   match_list : boy_spouse_list_type;

begin

   search_stable_marrige (

      boy_favorite_list, girl_favorite_list, match_list);

   for i in match_list'Range loop

      Put_Line (boy_id_type'Image (i) & " " &

                girl_id_type'Image (match_list (i)));

   end loop;

end stable_marrige;

 

文件2stable_marrige_match.ads (包规范)

package stable_marrige_match is

   MAX_COUPLE_NUMBER : constant := 4;

   type boy_id_type is new Natural range 0 .. MAX_COUPLE_NUMBER;

   type girl_id_type is new Positive range 1 .. MAX_COUPLE_NUMBER;

   type favorite_index_type is new Positive range 1 .. MAX_COUPLE_NUMBER;

   type boy_favorite_list_type is array

     (boy_id_type range 1 .. boy_id_type'Last,

      favorite_index_type) of girl_id_type;

   type girl_favorite_list_type is array

     (girl_id_type, favorite_index_type) of boy_id_type;

   type boy_spouse_list_type is array

     (boy_id_type range 1 .. boy_id_type'Last) of girl_id_type;

 

   procedure search_stable_marrige

     (boy_favorite_list  : boy_favorite_list_type;

      girl_favorite_list : girl_favorite_list_type;

      match_list         : out boy_spouse_list_type

     );

 

private

   type girl_spouse_list_type is array (girl_id_type) of boy_id_type;

 

   procedure push_boy_stack (boy_id : boy_id_type);

   function pop_boy_stack return boy_id_type;

   function get_favorite_index_of_boy

      (boy_id             : boy_id_type;

       girl_id            : girl_id_type;

       girl_favorite_list : girl_favorite_list_type

      ) return favorite_index_type;

end stable_marrige_match;

 

文件3stable_marrige_match.adb (包体)

with Ada.Text_IO;

use Ada.Text_IO;

 

package body stable_marrige_match is

   DUMMY_BOY_ID  : constant boy_id_type := 0;

   MAX_BOY_STACK : constant Positive := 100;

   type boy_stack_type is array

     (Positive range 1 .. MAX_BOY_STACK) of boy_id_type;

 

   boy_stack : boy_stack_type;

   boy_stack_index : Positive := boy_stack'First;

   boy_stack_overflow : exception;

 

   procedure push_boy_stack (boy_id : boy_id_type) is

   begin

      boy_stack (boy_stack_index) := boy_id;

      if boy_stack_index < boy_stack'Last then

         boy_stack_index := boy_stack_index + 1;

      else

         raise boy_stack_overflow;

      end if;

   end push_boy_stack;

 

   function pop_boy_stack return boy_id_type is

      boy_id : boy_id_type;

   begin

      if boy_stack_index > boy_stack'First then

         boy_stack_index := boy_stack_index - 1;

         boy_id := boy_stack (boy_stack_index);

      else

         boy_id := DUMMY_BOY_ID;

      end if;

      return boy_id;

   end pop_boy_stack;

 

   function get_favorite_index_of_boy

      (boy_id             : boy_id_type;

       girl_id            : girl_id_type;

       girl_favorite_list : girl_favorite_list_type

      ) return favorite_index_type is

      favorite_index : favorite_index_type;

   begin

      for i in favorite_index_type'Range loop

         if girl_favorite_list (girl_id, i) = boy_id then

            favorite_index := i;

            exit;

         end if;

      end loop;

      return favorite_index;

   end get_favorite_index_of_boy;

 

   procedure search_stable_marrige

     (boy_favorite_list  : boy_favorite_list_type;

      girl_favorite_list : girl_favorite_list_type;

      match_list         : out boy_spouse_list_type) is

 

      boy_spouse_list  : boy_spouse_list_type;

      girl_spouse_list : girl_spouse_list_type;

      boy_id           : boy_id_type;

      ex_boy_id        : boy_id_type;

      favorite_girl_id : girl_id_type;

 

   begin

      for i in girl_spouse_list'Range loop

         girl_spouse_list (i) := DUMMY_BOY_ID;

      end loop;

 

      for i in 1 .. boy_id_type'Last loop

         push_boy_stack (i);

      end loop;

 

      loop

         boy_id := pop_boy_stack;

         if boy_id = DUMMY_BOY_ID then

            exit;

         end if;

         push_boy_stack (boy_id);

         for favorite_index in favorite_index_type'Range loop

            favorite_girl_id := boy_favorite_list (boy_id, favorite_index);

            ex_boy_id := girl_spouse_list (favorite_girl_id);

            if ex_boy_id = DUMMY_BOY_ID then

               girl_spouse_list (favorite_girl_id) := boy_id;

               boy_spouse_list (boy_id) := favorite_girl_id;

               boy_id := pop_boy_stack;

               exit;

            elsif get_favorite_index_of_boy (boy_id,

                                             favorite_girl_id,

                                             girl_favorite_list) <

                  get_favorite_index_of_boy (ex_boy_id,

                                             favorite_girl_id,

                                             girl_favorite_list) then

               boy_id := pop_boy_stack;

               push_boy_stack (ex_boy_id);

               girl_spouse_list (favorite_girl_id) := boy_id;

               boy_spouse_list (boy_id) := favorite_girl_id;

               exit;

            end if;

         end loop;

      end loop;

      match_list := boy_spouse_list;

   end search_stable_marrige;

 

begin

   null;

exception

   when boy_stack_overflow =>

      Put_Line ("MAX_BOY_STACK = 100 is not enough");

   when others =>

      Put_Line ("stable_marrige_match internal error");

end stable_marrige_match;

评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值