(********************************************************************) (* Group Assignment Program - First Pass *) (* *) (* File: as-gp.p *) (* *) (* Author: Dr. Michael Redmond *) (* Copyright: Dr. Michael Redmond *) (* *) (* Date: 09/02/93 *) (* Last Modified: 09/15/93 *) (* Last Modified: 01/31/94 - modified for db class *) (* Last Modified: 09/12/94 - modified for info syst design class *) (* Last Modified: 02/03/95 - modified for db class *) (* Last Modified: 09/12/95 - modified for info syst design class *) (* Last Modified: 01/26/96 - modified for db class *) (* changes included updating evening class*) (* times to 6:00 and 7:30 (vs 6:10 & 7:40)*) (* Last Modified: 02/05/97 - modified for db class *) (* *) (* for assigning students to groups consistent with their schedule *) (* and project preference *) (* *) (* assumptions: *) (* 4 possible group projects rated 1 to 4 by studs (4 highest) *) (* @c2@ 9/12/94 now 1-5 *) (* @c3@ 9/12/95 now 5 possible projects rated 1-10 *) (* 11 time slots on M and W, 10 time slots on T and Th, *) (* 6 time slots on F, 5 time slots on weekend *) (* Time slots rated 1-5 (5 best) *) (* Experience rated 0-5 (5 most) *) (* @c1@ 1/31/94 now 0-10 *) (* @c3@ 9/21/95 now get students e-mail address at end of data *) (* @c4@ 1/26/96 now after experience but before e-mail address - get*) (* gpa, prev_class - 409 to indicate have already taken 409 *) (* (or 000 to indicate not), work-hours per week *) (* then on the next line, project grade goal *) (* @c5@ 2/05/97 now 63 time slots - divided up weekends more *) (* got rid of project grade goal - not useful *) (* *) (* Try to assign members so that all groups have meeting times *) (* rated 5 by all members *) (* If that fails, try to match with 4 or better *) (* If that fails, try to match with 3 or better *) (* *) (* Start by trying to assign students with the tightest *) (* restrictions and move down from there *) (* *) (* Assignments are rated based on: *) (* (Proj Rating * Times Rating * Exper Rating) - Unassignd Pen*) (* Where *) (* Proj rating is *product* of squares of students rating *) (* of the assigned project *) (* Times rating is some of ratings of times for all time *) (* periods in which all members have group rated >= 3 *) (* Exper rating is difference between highest experience *) (* and 2 smallest experience (+ constant 11 to ensure *) (* all values are positive). This rewards assignments *) (* in which one group member is experienced and others *) (* are not. *) (* Unassigned Penalty is number of students not assigned *) (* to a group times a large constant (currently 1 Mil) *) (* @c1@ 1/31/94 now constant is 5 Mil *) (* @c3@ 9/12/95 now constant is 10 Mil *) (* *) (* Groups are formed first, based on compatible schedules, then *) (* groups are assigned to a project. Project preferences are *) (* determined based on the proj rating (above) for each of *) (* the possible projects the group could be assigned to *) (* Then adjustments are made with the following goals: *) (* spread groups evenly among the most popular 3 of the 4 *) (* projects *) (* @c2@ 9/12/94 now - most popular 2 of the 4 projects *) (* Groups that favored the least popular projects are moved to *) (* their second choice project *) (* For projects that are too popular, the groups whose rating *) (* of their second choice project is closest to their *) (* rating of their first choice project are selected to *) (* be moved to their second choice *) (* *) (* *) (* Files: *) (* standard input, standard output, *) (* student input data (current version ~redmond/teach/409/f93/sd4*) (* results - quick glance at results using thresholds 5,4,3 *) (* (user specifies actual file name in response to prompt*) (* debug.txt - info about what students are hard to place, and *) (* info about what students like which time slots *) (* fresults - formal output of results using thresholds 5,4,3 *) (* designed to be readable by humans (e.g. students) *) (* (user specifies actual file name in response to prompt*) (* *) (* Procedures: *) (* init_time_code_arr - set words that go with time slot numbers *) (* find_stud -- find student in student array *) (* read_dat --- get input from file about each student *) (* convert_dat --- convert info about each student to info about *) (* each time slot *) (* find_numb_above_thresh_for_time -- find number of students *) (* above threshold for given time who have not been assigned *) (* to a group *) (* print_converted_dat -- print for each time slot, each *) (* students rating *) (* print_converted_compres_dat -- print for each time slot, each *) (* student who is close to the threshold *) (* count_numb_abov_thresh -- count number of time slots students *) (* were above the threshold *) (* sort_by_numb_abov_thresh -- sort_by number of time slots *) (* students were above the threshold *) (* sort_by_group_assign -- sort_by group students were assigned *) (* to *) (* print_numb_abov_thresh -- print number of time slots students *) (* were above the threshold *) (* print_group_assign -- print group assignments in a form that *) (* is short + easy to see which time slots are the same *) (* (numbered time slots instead of words) *) (* print_group_assign_for_students -- print group assignments in *) (* a form useful for people such as students to read *) (* assign -- assign students to a group - find most picky *) (* person not previously assigned to a group and find *) (* compatible people *) (* reset_assign -- reset group assignments to try again *) (* max4_old -- find largest element of array of 4 elements *) (* return which item is, and what value is *) (* max4 -- find largest element of array of 4 elements *) (* return which item is, and what value is *) (* min4 -- return smallest of array of 4 elements *) (* return which item is, and what value is *) (* hard_count_fav_projs -- count number of groups picked each *) (* project as favorite, returning array with count for each *) (* project. doesn't assume that each group's favorite has *) (* already been determined *) (* count_fav_projs -- count number of groups picked each *) (* project as favorite, returning array with count for each *) (* project. assumes that each groups favorite has already been*) (* determined *) (* old_find_groups_for_proj_fav -- for a given project number, *) (* find all groups that consider it the favored project *) (* find_groups_for_proj_fav -- for a given project number, find *) (* all groups that consider it the favored project *) (* prep_assign_projs -- prepare to assign groups (already *) (* constructed) to projects *) (* assign_to_fav_proj-- mark projects assigned from favorites *) (* move_from_unpopular_projs - *) (* largest_of_grps - - *) (* smallest_of_grps - - *) (* move_from_popular_projs -- need to move n groups to a *) (* different project where n is the difference between number *) (* of groups choosing a project and max number that I want to *) (* allow *) (* assign_projs -- assign groups (already constructed) to *) (* projects *) (* create_group_recs -- create records for each group after *) (* groups have been assigned *) (* rate_assign -- rate a group assignment *) (* also mark times that are ok or better for all members of *) (* group *) (* update_compat_times_in_stud_arr -- take compatible *) (* info from group info and copy it to the student array where*) (* it can be used for printing the group assignments *) (* process_with_threshold -- carry out process of assigning *) (* groups and projects and rating the assignment with a given *) (* threshold *) (* *) (* Functions: *) (* all_studs_ass -- tells if all students have been assigned a *) (* group *) (* *) (********************************************************************) PROGRAM groups (input,output,studdat,results,debug,fresults); CONST max_studs = 40; (* curr_studs = 9; *) (* @HERE *) curr_numb_studs = 37; (* max_groups = 9; *) max_groups = 12; (* max_groups = 6; *) (* max_groups = 10; *) no_group_ass = 999; (* curr_numb_groups = 11; *) (* curr_numb_groups = 6; *) curr_numb_groups = 12; (* curr_groups = 3; *) group_size = 3; (* following not important for db - change to high number from 4 *) (* for f94 409 make 4 out of 6 *) (* for f95 409 make 7 out of 12 *) max_grps_4_one_proj = 40; (* max_grps_4_one_proj = 7; *) (* @c5@ changed from 55 to 63 possible time slots *) numb_tim_slots = 63; (* @c3@ changed to 5 possible projs *) (* numb_projs = 4; *) old_numb_projs = 4; numb_projs = 5; min_ok_4_rate = 3; (* min time value ok for rating a group assignment *) arb_cutoff = 10; (* arbitrary cutoff for number of *) (* possible sets of group assignments *) (* will consider at one time *) (* @c3@ penalty increased due to projs rated to 10 instead of 5 *) unass_penalty = 1000000000; max_time_rate = 5; (* best rating somebody could give to a time slot *) max_exper_rate = 10; (* best rating for somebody 's level of experience *) TYPE sched_arr = ARRAY [1..numb_tim_slots] OF INTEGER; stud_rates = ARRAY [1..max_studs] OF INTEGER; rate_arr = ARRAY[1..numb_projs] OF INTEGER; (* @c3@ changed to 5 possible projs *) old_rate_arr = ARRAY[1..old_numb_projs] OF INTEGER; group_list_typ = ARRAY[1..max_groups] OF INTEGER; name_typ = PACKED ARRAY[1..25] OF CHAR; time_slot_words_typ = PACKED ARRAY[1..17] OF CHAR; (*@c3@*) email_addr_typ = PACKED ARRAY[1..20] OF CHAR; (*@c4@*) goal_typ = PACKED ARRAY[1..2] OF CHAR; stud_rec = RECORD name : name_typ; stud_numb : INTEGER; (*@c3@*) email : email_addr_typ; (*@c4@*) gpa : REAL; (*@c4@*) prev_class : INTEGER; (* when doing db this is 409 or 000 *) (* when doing is this is 433 or 000 *) (*@c4@*) goal : goal_typ; (*@c4@*) work_hrs : INTEGER; times : sched_arr; projs : rate_arr; experience : INTEGER; numb_abv_thresh : INTEGER; group_ass : INTEGER; proj_ass : INTEGER; compat_times : sched_arr; (* ratings of times compatible with *) (* group members *) END; stud_simp_rec = RECORD name : name_typ; grp_ass : INTEGER; END; stud_arr = ARRAY [1..max_studs] OF stud_rec; time_arr = ARRAY [1..numb_tim_slots] OF stud_rec; time_arr_simple = ARRAY [1..numb_tim_slots] OF stud_rates; group_typ = ARRAY[1..group_size] OF stud_rec; group_info = RECORD group_numb : INTEGER; group_memb_numb : INTEGER; (* number of members in group *) group_membs : group_typ; group_projs : rate_arr; (* group ratings for each of the projects *) group_rev_proj_rate : rate_arr; (* group ratings for each of the projects *) (* revised to eliminate groups to not consider *) group_fav_proj_rate : INTEGER; (* rating for group's favorite proj *) group_proj_ass : INTEGER; group_fav_proj : INTEGER; END; group_arr = ARRAY[1..(max_groups + 1)] OF group_info; full_grp_info = RECORD rating : INTEGER; groups : group_arr; END; group_poss = ARRAY[1..arb_cutoff] OF full_grp_info; time_code_rec = RECORD time_slot_numb : INTEGER; time_slot_words : time_slot_words_typ; END; time_code_arr = ARRAY[1..numb_tim_slots] OF time_code_rec; file_name_typ = PACKED ARRAY[1..12] OF CHAR; VAR all_studs : stud_arr; all_times : time_arr; simple_times : time_arr_simple; all_groups : group_arr; all_time_codes : time_code_arr; threshold : INTEGER; group_numb : INTEGER; (* current group number to be assigned *) assign_rating : REAL; numb_groups_assigned : INTEGER; VAR studdat,results,debug,fresults : text; VAR stud_file_name, results_file, debug_file : file_name_typ; VAR numb_reserv, numb_avail,numb_play_actual,numb_roto_play : INTEGER; (********************************************************************) (* Procedure: init_time_code_arr *) (* *) (* Function: *) (* Set up array relating time slot numbers with words telling day*) (* and time. *) (* *) (* Inputs: *) (* array of time codes (empty) *) (* *) (* Outputs: *) (* array of time codes updated with words *) (* *) (* Procedures: *) (* None. *) (* *) (* Functions: *) (* None. *) (* *) (********************************************************************) PROCEDURE init_time_code_arr (VAR all_time_codes : time_code_arr); VAR ii : INTEGER; BEGIN FOR ii := 1 TO numb_tim_slots DO BEGIN all_time_codes[ii].time_slot_numb := ii; END; all_time_codes[1].time_slot_words := 'Mon 8:00- 8:55am'; all_time_codes[2].time_slot_words := 'Mon 9:05-10:00am'; all_time_codes[3].time_slot_words := 'Mon 10:10-11:05am'; all_time_codes[4].time_slot_words := 'Mon 11:15-12:10am'; all_time_codes[5].time_slot_words := 'Mon 12:10- 1:10pm'; all_time_codes[6].time_slot_words := 'Mon 1:20- 2:40pm'; all_time_codes[7].time_slot_words := 'Mon 2:50- 4:10pm'; all_time_codes[8].time_slot_words := 'Mon 4:10- 5:40pm'; all_time_codes[9].time_slot_words := 'Mon 6:00- 7:20pm'; all_time_codes[10].time_slot_words := 'Mon 7:30- 8:50pm'; all_time_codes[11].time_slot_words := 'Mon 9:10-10:30pm'; all_time_codes[12].time_slot_words := 'Tue 8:00- 9:20am'; all_time_codes[13].time_slot_words := 'Tue 9:30-10:50am'; all_time_codes[14].time_slot_words := 'Tue 11:00-12:20am'; all_time_codes[15].time_slot_words := 'Tue 12:30- 1:50pm'; all_time_codes[16].time_slot_words := 'Tue 2:00- 3:20pm'; all_time_codes[17].time_slot_words := 'Tue 3:30- 4:50pm'; all_time_codes[18].time_slot_words := 'Tue 4:50- 6:00pm'; all_time_codes[19].time_slot_words := 'Tue 6:00- 7:20pm'; all_time_codes[20].time_slot_words := 'Tue 7:30- 8:50pm'; all_time_codes[21].time_slot_words := 'Tue 9:10-10:30pm'; all_time_codes[22].time_slot_words := 'Wed 8:00- 8:55am'; all_time_codes[23].time_slot_words := 'Wed 9:05-10:00am'; all_time_codes[24].time_slot_words := 'Wed 10:10-11:05am'; all_time_codes[25].time_slot_words := 'Wed 11:15-12:10am'; all_time_codes[26].time_slot_words := 'Wed 12:10- 1:10pm'; all_time_codes[27].time_slot_words := 'Wed 1:20- 2:40pm'; all_time_codes[28].time_slot_words := 'Wed 2:50- 4:10pm'; all_time_codes[29].time_slot_words := 'Wed 4:10- 5:40pm'; all_time_codes[30].time_slot_words := 'Wed 6:00- 7:20pm'; all_time_codes[31].time_slot_words := 'Wed 7:30- 8:50pm'; all_time_codes[32].time_slot_words := 'Wed 9:10-10:30pm'; all_time_codes[33].time_slot_words := 'Thr 8:00- 9:20am'; all_time_codes[34].time_slot_words := 'Thr 9:30-10:50am'; all_time_codes[35].time_slot_words := 'Thr 11:00-12:20am'; all_time_codes[36].time_slot_words := 'Thr 12:30- 1:50pm'; all_time_codes[37].time_slot_words := 'Thr 2:00- 3:20pm'; all_time_codes[38].time_slot_words := 'Thr 3:30- 4:50pm'; all_time_codes[39].time_slot_words := 'Thr 4:50- 6:00pm'; all_time_codes[40].time_slot_words := 'Thr 6:00- 7:20pm'; all_time_codes[41].time_slot_words := 'Thr 7:30- 8:50pm'; all_time_codes[42].time_slot_words := 'Thr 9:10-10:30pm'; all_time_codes[43].time_slot_words := 'Fri 8:00- 8:55am'; all_time_codes[44].time_slot_words := 'Fri 9:05-10:00am'; all_time_codes[45].time_slot_words := 'Fri 10:10-11:05am'; all_time_codes[46].time_slot_words := 'Fri 11:15-12:10am'; all_time_codes[47].time_slot_words := 'Fri 12:10- 1:10pm'; all_time_codes[48].time_slot_words := 'Fri 1:20- 4:20pm'; all_time_codes[49].time_slot_words := 'Fri evening '; all_time_codes[50].time_slot_words := 'Sat 8:00-10:00am'; all_time_codes[51].time_slot_words := 'Sat 10:00-12:00am'; all_time_codes[52].time_slot_words := 'Sat 12:00- 2:00pm'; all_time_codes[53].time_slot_words := 'Sat 2:00- 4:00pm'; all_time_codes[54].time_slot_words := 'Sat 4:00- 6:00pm'; all_time_codes[55].time_slot_words := 'Sat 6:00- 8:00pm'; all_time_codes[56].time_slot_words := 'Sat 8:00- later '; all_time_codes[57].time_slot_words := 'Sun 8:00-10:00am'; all_time_codes[58].time_slot_words := 'Sun 10:00-12:00am'; all_time_codes[59].time_slot_words := 'Sun 12:00- 2:00pm'; all_time_codes[60].time_slot_words := 'Sun 2:00- 4:00pm'; all_time_codes[61].time_slot_words := 'Sun 4:00- 6:00pm'; all_time_codes[62].time_slot_words := 'Sun 6:00- 8:00pm'; all_time_codes[63].time_slot_words := 'Sun 8:00- later '; END; (********************************************************************) (* Procedure: find_stud *) (* *) (* Function: *) (* find student in student array *) (* *) (* *) (* Inputs: *) (* a record (probably usually from a group) *) (* the array of all student records *) (* *) (* *) (* Outputs: *) (* an index into the student array *) (* *) (* *) (* Procedures: *) (* None. *) (* *) (* *) (* Functions: *) (* None. *) (* *) (********************************************************************) PROCEDURE find_stud (stud_to_find : stud_rec; all_studs : stud_arr; VAR stud_indx : INTEGER ); VAR ii : INTEGER; BEGIN FOR ii := 1 TO curr_numb_studs DO BEGIN IF all_studs[ii].name = stud_to_find.name THEN BEGIN (* found right student *) stud_indx := ii; END; END; END; (********************************************************************) (* Procedure: read_dat *) (* *) (* Function: *) (* get input from file about each student *) (* *) (* *) (* Inputs: *) (* the number of students to read info about *) (* the file to read info from *) (* *) (* Outputs: *) (* the array of all student records *) (* *) (* *) (* Procedures: *) (* None. *) (* *) (* *) (* Functions: *) (* None. *) (* *) (********************************************************************) PROCEDURE read_dat (numb_studs : INTEGER; VAR all_studs : stud_arr; VAR studdat : text); VAR rate_indx,time_indx,indx : INTEGER; BEGIN FOR indx := 1 TO numb_studs DO BEGIN WITH all_studs[indx] DO BEGIN READLN(studdat,name); WRITELN(name); FOR time_indx := 1 TO numb_tim_slots DO BEGIN READ(studdat,times[time_indx]); END; WRITELN(times[numb_tim_slots]); READLN(studdat); FOR rate_indx := 1 TO numb_projs DO BEGIN READ(studdat,projs[rate_indx]); END; WRITELN(projs[numb_projs]); READLN(studdat); (*@c4@*) READLN(studdat,experience,gpa,prev_class,work_hrs); (* WRITELN(experience,gpa,prev_class,work_hrs); *) (*@c4@*) (*@c5@*) (* READLN(studdat,goal); *) (* WRITELN(goal); *) (*@c3@*) READLN(studdat,email); (* WRITELN(email); *) group_ass := 0; END; END; END; (* read_dat *) (********************************************************************) (* Procedure: convert_dat *) (* *) (* Function: *) (* convert info about each student to info about each time slot *) (* *) (* *) (* Inputs: *) (* the number of students in the class *) (* the number of time slots we have data for *) (* the array of all student records *) (* *) (* *) (* Outputs: *) (* the array of all time slots with student info for the slot *) (* the array of all time slots with just student rating for the *) (* slot *) (* *) (* *) (* Procedures: *) (* None. *) (* *) (* *) (* Functions: *) (* None. *) (* *) (********************************************************************) PROCEDURE convert_dat (numb_studs : INTEGER; numb_tim_slots : INTEGER; all_studs : stud_arr; VAR all_times : time_arr; VAR simple_times : time_arr_simple); VAR time_indx,indx : INTEGER; BEGIN FOR indx := 1 TO numb_studs DO BEGIN WITH all_studs[indx] DO BEGIN FOR time_indx := 1 TO numb_tim_slots DO BEGIN (* get student's rating for this time slot *) simple_times[time_indx][indx] := times[time_indx]; END; END; END; END; (* convert_dat *) (********************************************************************) (* Procedure: find_numb_above_thresh_for_time *) (* *) (* Function: *) (* find number of students above threshold for given time *) (* who have not been assigned to a group *) (* *) (* *) (* Inputs: *) (* the number of students in the class *) (* the array of all student records *) (* the threshold to compare ratings to *) (* the time slot (number) of interest *) (* *) (* Outputs: *) (* the number of (avail) students who like the given time period *) (* *) (* Procedures: *) (* None. *) (* *) (* *) (* Functions: *) (* None. *) (* *) (********************************************************************) PROCEDURE find_numb_above_thresh_for_time (numb_studs : INTEGER; all_studs : stud_arr; thresh : INTEGER; time : INTEGER; VAR numb_above : INTEGER ); VAR indx : INTEGER; BEGIN numb_above := 0; FOR indx := 1 TO numb_studs DO BEGIN IF (all_studs[indx].times[time] >= thresh) AND (all_studs[indx].group_ass = 0) THEN BEGIN (* student not assigned to a group is above threshold *) (* for this time *) numb_above := numb_above + 1; END; END; END; (********************************************************************) (* Procedure: print_converted_dat *) (* *) (* Function: *) (* print all students rating for each time slot *) (* *) (* *) (* Inputs: *) (* the number of students in the class *) (* the number of time slots we have data for *) (* the array of all student records *) (* the array of all time slots with just student rating for the *) (* slot *) (* *) (* *) (* Outputs: *) (* None. *) (* *) (* *) (* Procedures: *) (* None. *) (* *) (* *) (* Functions: *) (* None. *) (* *) (********************************************************************) PROCEDURE print_converted_dat (numb_studs,numb_tim_slots : INTEGER; all_studs : stud_arr; simple_times : time_arr_simple); VAR rate_indx,time_indx,indx : INTEGER; BEGIN WRITELN(debug,' TIME RATINGS'); FOR time_indx := 1 TO numb_tim_slots DO BEGIN WRITELN(debug,' TIME: ',time_indx:2,' Time Rate Exper GPA Proj Ratings'); FOR indx := 1 TO numb_studs DO BEGIN WRITE(debug,' Student: ',indx:2,' ', all_studs[indx].name,' ', simple_times[time_indx][indx]:2,' '); WRITE(debug,all_studs[indx].experience:8); (*@c4@*) WRITE(debug,' ',all_studs[indx].gpa:4:2); FOR rate_indx := 1 TO numb_projs DO BEGIN WRITE(debug,all_studs[indx].projs[rate_indx]:2,' '); END; WRITELN(debug); END; END; WRITELN(debug); WRITELN(debug); WRITELN(debug); WRITELN(debug); WRITELN(debug); END; (* print_converted_dat *) (********************************************************************) (* Procedure: print_converted_compres_dat *) (* *) (* Function: *) (* print for each time slot, each student who is close to the *) (* threshold *) (* *) (* *) (* Inputs: *) (* the number of students in the class *) (* the number of time slots we have data for *) (* the array of all student records *) (* the array of all time slots with just student rating for the *) (* slot *) (* the threshold to compare ratings to *) (* *) (* *) (* Outputs: *) (* None. *) (* *) (* *) (* Procedures: *) (* None. *) (* *) (* *) (* Functions: *) (* None. *) (* *) (********************************************************************) PROCEDURE print_converted_compres_dat (numb_studs,numb_tim_slots : INTEGER; all_studs : stud_arr; simple_times : time_arr_simple; all_time_codes : time_code_arr; threshold : INTEGER); CONST diff = 1; VAR rate_indx,time_indx,indx : INTEGER; close_thresh : INTEGER; BEGIN close_thresh := threshold - 1; WRITELN(debug,' TIME RATINGS'); FOR time_indx := 1 TO numb_tim_slots DO BEGIN (* @c5@ *) (* include user readable time with debug output *) WRITELN(debug,' TIME: ',time_indx:2,' ', all_time_codes[time_indx].time_slot_words, ' Time Rate X '); (* ' Time Rate Exper GPA Proj Ratings'); *) FOR indx := 1 TO numb_studs DO BEGIN IF simple_times[time_indx][indx] >= close_thresh THEN BEGIN (* print student only if close to threshhold *) WRITE(debug,' Student: ',indx:2,' ', all_studs[indx].name,' ', simple_times[time_indx][indx]:2,' '); WRITE(debug,all_studs[indx].experience:4,' '); (*@c4@*) WRITE(debug,' ',all_studs[indx].gpa:4:2,' '); FOR rate_indx := 1 TO numb_projs DO BEGIN WRITE(debug,all_studs[indx].projs[rate_indx]:2,' '); END; WRITELN(debug); END; END; END; END; (* print_converted_compres_dat *) (********************************************************************) (* Procedure: count_numb_abov_thresh *) (* *) (* Function: *) (* count number of time slots students were above the threshold *) (* *) (* *) (* Inputs: *) (* the number of students in the class *) (* the array of all student records *) (* the threshold to compare ratings to *) (* *) (* *) (* Outputs: *) (* the array of all student records updated with the number of *) (* time slots each student's rating exceeded the threshold *) (* *) (* *) (* Procedures: *) (* None. *) (* *) (* *) (* Functions: *) (* None. *) (* *) (********************************************************************) PROCEDURE count_numb_abov_thresh (numb_studs : INTEGER; VAR all_studs : stud_arr; threshold : INTEGER ); VAR time_indx,indx : INTEGER; BEGIN FOR indx := 1 TO numb_studs DO BEGIN WITH all_studs[indx] DO BEGIN numb_abv_thresh := 0; FOR time_indx := 1 TO numb_tim_slots DO BEGIN (* if student rated time above threshold then adj count *) IF times[time_indx] >= threshold THEN BEGIN numb_abv_thresh := numb_abv_thresh + 1; END; END; END; END; END; (* count_numb_abov_thresh *) (********************************************************************) (* Procedure: sort_by_numb_abov_thresh *) (* *) (* Function: *) (* sort_by number of time slots students were above the threshold*) (* *) (* *) (* Inputs: *) (* the number of students in the class *) (* the array of all student records *) (* *) (* *) (* Outputs: *) (* the array of all student records sorted by how picky they are *) (* *) (* *) (* Procedures: *) (* None. *) (* *) (* *) (* Functions: *) (* None. *) (* *) (********************************************************************) PROCEDURE sort_by_numb_abov_thresh (numb_studs : INTEGER; VAR all_studs : stud_arr ); VAR inner,outer : INTEGER; temp_stud : stud_rec; BEGIN FOR outer := 1 TO (numb_studs - 1) DO BEGIN FOR inner := (outer + 1) TO numb_studs DO BEGIN IF all_studs[outer].numb_abv_thresh > all_studs[inner].numb_abv_thresh THEN BEGIN (* swap order *) temp_stud := all_studs[outer]; all_studs[outer] := all_studs[inner]; all_studs[inner] := temp_stud; END; END; END; END; (* sort_by_numb_abov_thresh *) (********************************************************************) (* Procedure: sort_by_group_assign *) (* *) (* Function: *) (* sort_by group students were assigned to *) (* *) (* *) (* Inputs: *) (* the number of students in the class *) (* the array of all student records *) (* *) (* *) (* Outputs: *) (* the array of all student records sorted what group they were *) (* assigned to *) (* *) (* Procedures: *) (* None. *) (* *) (* *) (* Functions: *) (* None. *) (* *) (********************************************************************) PROCEDURE sort_by_group_assign (numb_studs : INTEGER; VAR all_studs : stud_arr ); VAR inner,outer : INTEGER; temp_stud : stud_rec; BEGIN FOR outer := 1 TO (numb_studs - 1) DO BEGIN FOR inner := (outer + 1) TO numb_studs DO BEGIN IF all_studs[outer].group_ass > all_studs[inner].group_ass THEN BEGIN (* swap order *) temp_stud := all_studs[outer]; all_studs[outer] := all_studs[inner]; all_studs[inner] := temp_stud; END; END; END; END; (* sort_by_group_assign *) (********************************************************************) (* Procedure: print_numb_abov_thresh *) (* *) (* Function: *) (* print number of time slots students were above the threshold *) (* and which time slots *) (* *) (* Inputs: *) (* the number of students in the class *) (* the array of all student records *) (* the threshold to compare ratings to *) (* *) (* *) (* Outputs: *) (* None. *) (* *) (* *) (* Procedures: *) (* None. *) (* *) (* *) (* Functions: *) (* None. *) (* *) (********************************************************************) PROCEDURE print_numb_abov_thresh (numb_studs : INTEGER; VAR all_studs : stud_arr; threshold : INTEGER ); VAR rate_indx,time_indx,indx : INTEGER; count : INTEGER; BEGIN WRITELN(debug,' STUDENT DIFFICULTY'); WRITELN(debug,'Student Exper GPA Proj Rates Numb Abov Times'); FOR indx := 1 TO numb_studs DO BEGIN WITH all_studs[indx] DO BEGIN WRITE(debug,' ',name); WRITE(debug,' ',experience:1,' '); (*@c4@*) WRITE(debug,' ',gpa:4:2,' '); FOR rate_indx := 1 TO numb_projs DO BEGIN WRITE(debug,all_studs[indx].projs[rate_indx]:2,' '); END; WRITE(debug,numb_abv_thresh:5,' '); count := 1; FOR time_indx := 1 TO numb_tim_slots DO BEGIN (* if student rated time above threshold then print *) IF times[time_indx] >= threshold THEN BEGIN WRITE(debug,time_indx:3,'(',times[time_indx]:1,')'); count := count + 1; (* improve formatting *) IF count = 10 THEN BEGIN WRITELN(debug); WRITE(debug,' '); count := 1; END; END; END; WRITELN(debug); END; END; END; (* print_numb_abov_thresh *) (********************************************************************) (* Procedure: print_group_assign *) (* *) (* Function: *) (* print the group assignments for all students and the good time*) (* slots for each student *) (* *) (* Inputs: *) (* the number of students in the class *) (* the array of all student records *) (* the threshold to compare ratings to *) (* *) (* *) (* Outputs: *) (* None. *) (* *) (* *) (* Procedures: *) (* None. *) (* *) (* *) (* Functions: *) (* None. *) (* *) (********************************************************************) PROCEDURE print_group_assign (numb_studs : INTEGER; VAR all_studs : stud_arr; threshold : INTEGER ); VAR rate_indx,time_indx,indx : INTEGER; count : INTEGER; BEGIN WRITELN(results); WRITELN(results); WRITELN(results); WRITELN(results); WRITELN(results); WRITELN(results,' GROUP ASSIGNMENTS '); WRITELN(results,'Group Student Experience', ' GPA Goal Prev Work Proj Rate Numb Abov Times'); FOR indx := 1 TO numb_studs DO BEGIN WITH all_studs[indx] DO BEGIN WRITE(results,group_ass:3,' ',name); WRITE(results,experience:4,' '); (*@c4@*) WRITE(results,gpa:4:2,' '); (*@c4@*) (*@c5@*) (* WRITE(results,goal,' '); *) (*@c4@*) WRITE(results,prev_class:3,' '); (*@c4@*) WRITE(results,work_hrs:3,' '); FOR rate_indx := 1 TO numb_projs DO BEGIN WRITE(results,all_studs[indx].projs[rate_indx]:2,' '); END; WRITE(results,' ',numb_abv_thresh:6,' '); count := 1; FOR time_indx := 1 TO numb_tim_slots DO BEGIN (* if student rated time above threshold then print *) IF times[time_indx] >= threshold THEN BEGIN WRITE(results,time_indx:3,'(',times[time_indx]:1,')'); count := count + 1; (* improve formatting *) IF count = 10 THEN BEGIN WRITELN(results); WRITE(results,' '); count := 1; END; END; END; WRITELN(results); (* print times that were close too *) WRITE(results,' '); count := 1; FOR time_indx := 1 TO numb_tim_slots DO BEGIN (* if student rated time close to threshold then print *) IF times[time_indx] = (threshold - 1) THEN BEGIN WRITE(results,time_indx:3,'(',times[time_indx]:1,')'); count := count + 1; (* improve formatting *) IF count = 10 THEN BEGIN WRITELN(results); WRITE(results,' '); count := 1; END; END; END; WRITELN(results); WRITELN(results,'PROJECT ASSIGNED: ',proj_ass:3); WRITELN(results); END; END; WRITELN(results); WRITELN(results); WRITELN(results); WRITELN(results); WRITELN(results); END; (* print_group_assign *) (********************************************************************) (* Procedure: *) (* *) (* Function: *) (* *) (* *) (* Inputs: *) (* *) (* *) (* Outputs: *) (* *) (* *) (* Procedures: *) (* *) (* *) (* Functions: *) (* None. *) (* *) (********************************************************************) (* print group assignments in a form useful for people such as *) (* students to read *) PROCEDURE print_group_assign_for_students (numb_studs : INTEGER; VAR all_studs : stud_arr; threshold : INTEGER; all_time_codes : time_code_arr ); VAR rate_indx,time_indx,indx : INTEGER; count : INTEGER; BEGIN WRITELN(fresults,' GROUP ASSIGNMENTS '); (*@c3@*) WRITELN(fresults,'Group Student Experience', ' GPA Goal Prev Work Proj Rate Numb Abov Email Times'); FOR indx := 1 TO numb_studs DO BEGIN WITH all_studs[indx] DO BEGIN WRITE(fresults,group_ass:3,' ',name); WRITE(fresults,experience:4,' '); (*@c4@*) WRITE(fresults,gpa:4:2,' '); (*@c4@*) (*@c5@*) (* WRITE(fresults,goal,' '); *) (*@c4@*) WRITE(fresults,prev_class:3,' '); (*@c4@*) WRITE(fresults,work_hrs:3,' '); FOR rate_indx := 1 TO numb_projs DO BEGIN WRITE(fresults,all_studs[indx].projs[rate_indx]:2,' '); END; WRITELN(fresults,' ',numb_abv_thresh:6,' '); (*@c3@*) WRITELN(fresults,' ',email,' '); count := 1; FOR time_indx := 1 TO numb_tim_slots DO BEGIN (* if student rated time above threshold then print *) IF times[time_indx] >= threshold THEN BEGIN WRITE(fresults,' ', all_time_codes[time_indx].time_slot_words, ' ','(',times[time_indx]:1,')'); (* if time is good for all group members *) (* mark the time *) IF compat_times[time_indx] <> 0 THEN BEGIN WRITELN(fresults,' * '); END ELSE BEGIN WRITELN(fresults,' '); END; count := count + 1; (* improve formatting *) IF count = 10 THEN BEGIN (* WRITELN(fresults); *) (* WRITE(fresults,' '); *) count := 1; END; END; END; WRITELN(fresults); (* print times that were close too *) count := 1; FOR time_indx := 1 TO numb_tim_slots DO BEGIN (* if student rated time close to threshold then print *) IF times[time_indx] = (threshold - 1) THEN BEGIN WRITE(fresults,' ', all_time_codes[time_indx].time_slot_words, ' ','(',times[time_indx]:1,')'); (* if time is good for all group members *) (* mark the time *) IF compat_times[time_indx] <> 0 THEN BEGIN WRITELN(fresults,' * '); END ELSE BEGIN WRITELN(fresults,' '); END; count := count + 1; (* improve formatting *) IF count = 10 THEN BEGIN (* WRITELN(fresults); *) (* WRITE(fresults,' '); *) count := 1; END; END; END; WRITELN(fresults); WRITELN(fresults); WRITELN(fresults,'PROJECT ASSIGNED: ',proj_ass:3); WRITELN(fresults); WRITELN(fresults); END; END; WRITELN(fresults); WRITELN(fresults); WRITELN(fresults); WRITELN(fresults); WRITELN(fresults); WRITELN(fresults); WRITELN(fresults); WRITELN(fresults); WRITELN(fresults); END; (* print_group_assign *) (* tells if all students have been assigned a group *) FUNCTION all_studs_ass (all_studs : stud_arr; numb_studs : INTEGER ) : BOOLEAN; VAR temp : BOOLEAN; indx : INTEGER; BEGIN (* as a default indicate that all students are assigned *) temp := true; FOR indx := 1 TO numb_studs DO BEGIN IF all_studs[indx].group_ass = 0 THEN BEGIN (* somebody isn't assigned *) temp := false; END; END; (* return result *) all_studs_ass := temp; END; (********************************************************************) (* Procedure: *) (* *) (* Function: *) (* *) (* *) (* Inputs: *) (* *) (* *) (* Outputs: *) (* *) (* *) (* Procedures: *) (* *) (* *) (* Functions: *) (* None. *) (* *) (********************************************************************) (* assign students to a group - find most picky person not *) (* previously assigned to a group and find compatible people *) PROCEDURE assign (numb_studs : INTEGER; VAR all_studs : stud_arr; simple_times : time_arr_simple; threshold : INTEGER; VAR curr_group_numb : INTEGER); VAR time_indx,indx : INTEGER; ii,next_stud : INTEGER; found_stud,found_tim,found_group : BOOLEAN; found_per : BOOLEAN; numb_above : INTEGER; BEGIN WRITELN('In assign'); numb_above := 0; indx := 1; found_stud := false; (* not to most picky remaining *) found_group := false; (* haven't found group yet *) WHILE (NOT found_stud) AND (indx <= numb_studs) DO BEGIN (* go until have most picky student not yet assigned *) IF all_studs[indx].group_ass <> 0 THEN BEGIN (* keep looking *) indx := indx + 1; END ELSE BEGIN (* try to find a time that will work *) found_tim := false; (* not to time that will work *) time_indx := 1; WHILE (NOT found_tim) AND (time_indx <= numb_tim_slots) DO BEGIN find_numb_above_thresh_for_time (numb_studs,all_studs,threshold, time_indx,numb_above); (* debugging *) (* WRITELN('Number above threshold = ',threshold:2, *) (* ' for time period = ',time_indx:2,' == ', *) (* numb_above:3); *) IF (all_studs[indx].times[time_indx] >= threshold) AND (numb_above >= group_size) THEN BEGIN (* time is ok for this student and at least *) (* 3 unassigned students like this time *) found_tim := true; END ELSE BEGIN (* keep looking *) time_indx := time_indx + 1; END; END; (* found time or no time will work *) IF time_indx > numb_tim_slots THEN BEGIN (* no time will work *) all_studs[indx].group_ass := no_group_ass; (* debugging *) WRITELN('No time ok for ',all_studs[indx].name); END ELSE BEGIN (* found time *) (* collect first three pickiest students with compatible *) (* compatible time slot and assign them to group *) (* debugging *) WRITELN('Found time ok for ', all_studs[indx].name,' Time ', time_indx); WRITELN('Group numb =', curr_group_numb:3); all_studs[indx].group_ass := curr_group_numb; next_stud := indx; found_per := false; FOR ii := 1 TO 2 DO BEGIN WHILE ((next_stud <= curr_numb_studs) AND ((all_studs[next_stud].times[time_indx] < threshold) OR (all_studs[next_stud].group_ass <> 0))) DO BEGIN (* loop until find next stud to assign *) (* need to keep going until above thresh and not already assigned *) next_stud := next_stud + 1; END; IF next_stud <= curr_numb_studs THEN BEGIN (* found person to assign *) all_studs[next_stud].group_ass := curr_group_numb; (* debugging *) WRITELN('Found next student ok for time ', all_studs[indx].name,' ', all_studs[next_stud].name, ' Time ', time_indx); next_stud := next_stud + 1; END; END; (* move to next group *) curr_group_numb := curr_group_numb + 1; END; END; END; END; (* assign *) (********************************************************************) (* Procedure: *) (* *) (* Function: *) (* *) (* *) (* Inputs: *) (* *) (* *) (* Outputs: *) (* *) (* *) (* Procedures: *) (* *) (* *) (* Functions: *) (* None. *) (* *) (********************************************************************) (* reset group assignments to try again *) PROCEDURE reset_assign (numb_studs : INTEGER; VAR all_studs : stud_arr ); VAR indx : INTEGER; BEGIN FOR indx := 1 TO numb_studs DO BEGIN WITH all_studs[indx] DO BEGIN group_ass := 0; proj_ass := 0; END; END; END; (* reset_assign *) (********************************************************************) (* Procedure: *) (* *) (* Function: *) (* *) (* *) (* Inputs: *) (* *) (* *) (* Outputs: *) (* *) (* *) (* Procedures: *) (* *) (* *) (* Functions: *) (* None. *) (* *) (********************************************************************) PROCEDURE max4_old (first,sec,third,fourth : INTEGER; VAR largest, larg_val : INTEGER); BEGIN IF first > sec THEN IF third > fourth THEN IF first > third THEN BEGIN largest := 1; larg_val := first; END ELSE BEGIN largest := 3; larg_val := third; END ELSE BEGIN (* first greater than sec, fourth > third *) IF first > fourth THEN BEGIN largest := 1; larg_val := first; END ELSE BEGIN largest := 4; larg_val := fourth; END END ELSE BEGIN (* sec greater than first *) IF third > fourth THEN IF sec > third THEN BEGIN largest := 2; larg_val := sec; END ELSE BEGIN largest := 3; larg_val := third; END ELSE BEGIN (* sec greater than first, fourth > third *) IF sec > fourth THEN BEGIN largest := 2; larg_val := sec; END ELSE BEGIN largest := 4; larg_val := fourth; END END; END; END; (* max4 *) (********************************************************************) (* Procedure: *) (* *) (* Function: *) (* *) (* *) (* Inputs: *) (* *) (* *) (* Outputs: *) (* *) (* *) (* Procedures: *) (* *) (* *) (* Functions: *) (* None. *) (* *) (********************************************************************) (* find lartgest element of array of 4 elements *) (* return which item is, and what value is *) PROCEDURE max4 (list : rate_arr; VAR largest, larg_val : INTEGER); VAR indices : rate_arr; temp : INTEGER; ii,jj : INTEGER; BEGIN (* initialize indices *) FOR ii := 1 TO 4 DO indices[ii] := ii; FOR ii := 1 TO 3 DO BEGIN FOR jj := (ii + 1) TO 4 DO BEGIN IF list[jj] > list[ii] THEN BEGIN (* swap list and indices *) temp := list[jj]; list[jj] := list[ii]; list[ii] := temp; (* keep track of which of the orginal elements is *) (* which *) temp := indices[jj]; indices[jj] := indices[ii]; indices[ii] := temp; END; END; END; largest := indices[1]; larg_val := list[1]; END; (* max4 *) (********************************************************************) (* Procedure: *) (* *) (* Function: *) (* *) (* *) (* Inputs: *) (* *) (* *) (* Outputs: *) (* *) (* *) (* Procedures: *) (* *) (* *) (* Functions: *) (* None. *) (* *) (********************************************************************) (* return smallest of array of 4 elements *) (* return which item is, and what value is *) PROCEDURE min4 (list : rate_arr; VAR smallest, small_val : INTEGER); VAR indices : rate_arr; temp : INTEGER; ii,jj : INTEGER; BEGIN (* initialize indices *) FOR ii := 1 TO 4 DO indices[ii] := ii; FOR ii := 1 TO 3 DO BEGIN FOR jj := (ii + 1) TO 4 DO BEGIN IF list[jj] < list[ii] THEN BEGIN (* swap list and indices *) temp := list[jj]; list[jj] := list[ii]; list[ii] := temp; (* keep track of which of the orginal elements is *) (* which *) temp := indices[jj]; indices[jj] := indices[ii]; indices[ii] := temp; END; END; END; smallest := indices[1]; small_val := list[1]; END; (* min4 *) (********************************************************************) (* Procedure: *) (* *) (* Function: *) (* *) (* *) (* Inputs: *) (* *) (* *) (* Outputs: *) (* *) (* *) (* Procedures: *) (* *) (* *) (* Functions: *) (* None. *) (* *) (********************************************************************) (*@c3@*) (* find largest element of array of 5 elements *) (* return which item is, and what value is *) PROCEDURE max5 (list : rate_arr; VAR largest, larg_val : INTEGER); VAR indices : rate_arr; temp : INTEGER; ii,jj : INTEGER; BEGIN (* initialize indices *) FOR ii := 1 TO 5 DO indices[ii] := ii; FOR ii := 1 TO 4 DO BEGIN FOR jj := (ii + 1) TO 5 DO BEGIN IF list[jj] > list[ii] THEN BEGIN (* swap list and indices *) temp := list[jj]; list[jj] := list[ii]; list[ii] := temp; (* keep track of which of the orginal elements is *) (* which *) temp := indices[jj]; indices[jj] := indices[ii]; indices[ii] := temp; END; END; END; largest := indices[1]; larg_val := list[1]; END; (* max5 *) (********************************************************************) (* Procedure: *) (* *) (* Function: *) (* *) (* *) (* Inputs: *) (* *) (* *) (* Outputs: *) (* *) (* *) (* Procedures: *) (* *) (* *) (* Functions: *) (* None. *) (* *) (********************************************************************) (*@c3@*) (* return smallest of array of 5 elements *) (* return which item is, and what value is *) PROCEDURE min5 (list : rate_arr; VAR smallest, small_val : INTEGER); VAR indices : rate_arr; temp : INTEGER; ii,jj : INTEGER; BEGIN (* initialize indices *) FOR ii := 1 TO 5 DO indices[ii] := ii; FOR ii := 1 TO 4 DO BEGIN FOR jj := (ii + 1) TO 5 DO BEGIN IF list[jj] < list[ii] THEN BEGIN (* swap list and indices *) temp := list[jj]; list[jj] := list[ii]; list[ii] := temp; (* keep track of which of the orginal elements is *) (* which *) temp := indices[jj]; indices[jj] := indices[ii]; indices[ii] := temp; END; END; END; smallest := indices[1]; small_val := list[1]; END; (* min5 *) (********************************************************************) (* Procedure: *) (* *) (* Function: *) (* *) (* *) (* Inputs: *) (* *) (* *) (* Outputs: *) (* *) (* *) (* Procedures: *) (* *) (* *) (* Functions: *) (* None. *) (* *) (********************************************************************) (* count number of groups picked each project as favorite *) (* returning array with count for each project *) (* doesn't assume that each group's favorite has already been *) (* determined *) PROCEDURE hard_count_fav_projs (all_groups : group_arr; VAR favs : rate_arr); VAR largest,largest_val : INTEGER; rate_indx,indx : INTEGER; temp_group_projs : rate_arr; BEGIN (* initialize *) FOR rate_indx := 1 TO numb_projs DO BEGIN favs[rate_indx] := 0; END; FOR indx := 1 TO max_groups DO BEGIN WITH all_groups[indx] DO BEGIN (* find most popular project and update approp counter *) temp_group_projs := group_projs; (*@c3@*) (* max4(temp_group_projs,largest,largest_val); *) max5(temp_group_projs,largest,largest_val); favs[largest] := favs[largest] + 1; END; END; END; (* hard_count_fav_projs *) (********************************************************************) (* Procedure: *) (* *) (* Function: *) (* *) (* *) (* Inputs: *) (* *) (* *) (* Outputs: *) (* *) (* *) (* Procedures: *) (* *) (* *) (* Functions: *) (* None. *) (* *) (********************************************************************) (* count number of groups picked each project as favorite *) (* returning array with count for each project *) (* assumes that each group's favorite has already been *) (* determined *) PROCEDURE count_fav_projs (all_groups : group_arr; VAR favs : rate_arr; numb_grps_ass : INTEGER); VAR largest,largest_val : INTEGER; rate_indx,indx : INTEGER; BEGIN (* initialize *) FOR rate_indx := 1 TO numb_projs DO BEGIN favs[rate_indx] := 0; END; FOR indx := 1 TO (*max_groups*) numb_grps_ass DO BEGIN WITH all_groups[indx] DO BEGIN (* find most popular project and update approp counter *) largest := group_fav_proj; favs[largest] := favs[largest] + 1; END; END; END; (* count_fav_projs *) (********************************************************************) (* Procedure: *) (* *) (* Function: *) (* *) (* *) (* Inputs: *) (* *) (* *) (* Outputs: *) (* *) (* *) (* Procedures: *) (* *) (* *) (* Functions: *) (* None. *) (* *) (********************************************************************) (* for a given project number, find all groups that consider it *) (* the favored project *) PROCEDURE old_find_groups_for_proj_fav (all_groups : group_arr; proj_number : INTEGER; VAR group_list : group_list_typ; VAR count : INTEGER); VAR indx,largest,large_val : INTEGER; BEGIN (* initialize *) FOR indx := 1 TO max_groups DO group_list[indx] := 0; count := 0; FOR indx := 1 TO max_groups DO BEGIN WITH all_groups[indx] DO BEGIN (*@c3@*) (* max4(group_projs,largest,large_val); *) max5(group_projs,largest,large_val); IF largest = proj_number THEN BEGIN (* group's favorite proj is the one of interest *) count := count + 1; group_list[count] := indx; END; END; END; END; (* old_find_groups_for_proj_fav *) (********************************************************************) (* Procedure: *) (* *) (* Function: *) (* *) (* *) (* Inputs: *) (* *) (* *) (* Outputs: *) (* *) (* *) (* Procedures: *) (* *) (* *) (* Functions: *) (* None. *) (* *) (********************************************************************) (* for a given project number, find all groups that consider it *) (* the favored project *) PROCEDURE find_groups_for_proj_fav (all_groups : group_arr; proj_number : INTEGER; VAR group_list : group_list_typ; VAR count : INTEGER; numb_grps_ass : INTEGER); VAR indx,largest,large_val : INTEGER; BEGIN (* initialize *) FOR indx := 1 TO max_groups DO group_list[indx] := 0; count := 0; FOR indx := 1 TO (*max_groups*) numb_grps_ass DO BEGIN WITH all_groups[indx] DO BEGIN (* find most popular project and update approp counter *) largest := group_fav_proj; IF largest = proj_number THEN BEGIN (* group's favorite proj is the one of interest *) count := count + 1; group_list[count] := indx; END; END; END; END; (* find_groups_for_proj_fav *) (********************************************************************) (* Procedure: *) (* *) (* Function: *) (* *) (* *) (* Inputs: *) (* *) (* *) (* Outputs: *) (* *) (* *) (* Procedures: *) (* *) (* *) (* Functions: *) (* None. *) (* *) (********************************************************************) (* prepare to assign groups (already constructed) to projects *) PROCEDURE prep_assign_projs (numb_studs : INTEGER; VAR all_groups : group_arr; numb_grps_ass : INTEGER ); VAR proj_indx,memb_indx,indx : INTEGER; total_proj : INTEGER; (* temp rating of project for group *) BEGIN (* rate each groups liking of each project *) FOR indx := 1 TO (*max_groups*) numb_grps_ass DO BEGIN WITH all_groups[indx] DO BEGIN FOR proj_indx := 1 TO numb_projs DO BEGIN total_proj := 1; FOR memb_indx := 1 TO group_size DO BEGIN WITH group_membs[memb_indx] DO BEGIN total_proj := total_proj * (projs[proj_indx] * projs[proj_indx]); END; END; (* total rating for a project for a group *) group_projs[proj_indx] := total_proj; END; (* take ratings of projects by group and put favorite *) (* in record *) (*@c3@*) (* max4(group_projs,group_fav_proj,group_fav_proj_rate); *) max5(group_projs,group_fav_proj,group_fav_proj_rate); END; END; END; (* prep_assign_projs *) (********************************************************************) (* Procedure: *) (* *) (* Function: *) (* *) (* *) (* Inputs: *) (* *) (* *) (* Outputs: *) (* *) (* *) (* Procedures: *) (* *) (* *) (* Functions: *) (* None. *) (* *) (********************************************************************) (* mark projects assigned from favorites *) PROCEDURE assign_to_fav_proj( VAR all_groups : group_arr; VAR all_studs : stud_arr ; numb_grps_ass : INTEGER); VAR indx,ii : INTEGER; BEGIN WRITELN('In assign_to_fav_projs'); FOR indx := 1 TO (*max_groups*) numb_grps_ass DO BEGIN WITH all_groups[indx] DO BEGIN group_proj_ass := group_fav_proj; (* for each member in group *) FOR ii := 1 TO group_size DO BEGIN WITH group_membs[ii] DO BEGIN (* set correct group in group array *) (* and in student array *) proj_ass := group_proj_ass; (* stud_numb is *) (* all_groups[indx].group_membs[ii].stud_numb *) (* group_proj_ass is from all_groups[indx] *) all_studs[stud_numb].proj_ass := group_proj_ass; END; END; END; END; END; (* assign_to_fav_proj *) (********************************************************************) (* Procedure: *) (* *) (* Function: *) (* *) (* *) (* Inputs: *) (* *) (* *) (* Outputs: *) (* *) (* *) (* Procedures: *) (* *) (* *) (* Functions: *) (* None. *) (* *) (********************************************************************) PROCEDURE move_from_unpopular_projs (VAR all_groups : group_arr; groups_to_move : group_list_typ; VAR fav_projs : rate_arr; least_fav,least_fav_count : INTEGER; numb_grps_ass : INTEGER); VAR ii : INTEGER; poss_new_proj : INTEGER; rating : INTEGER; group_numb : INTEGER; group_prefs : rate_arr; BEGIN WRITELN('In move_from_unpopular_projs'); (* find groups second choice *) (* and put them in there *) FOR ii := 1 TO least_fav_count DO BEGIN group_numb := groups_to_move[ii]; group_prefs := all_groups[group_numb].group_projs; (* eliminate highest rating and get next highest *) group_prefs[least_fav] := 0; (*@c3@*) (* max4(group_prefs,poss_new_proj,rating); *) max5(group_prefs,poss_new_proj,rating); (* check if already full *) If fav_projs[poss_new_proj] < max_grps_4_one_proj THEN BEGIN (* room to add *) (* debugging *) WRITELN('second choice proj works, group',group_numb:3, 'moved from project ',least_fav:3,' to project ', poss_new_proj:3); (* adjust count for proj *) fav_projs[poss_new_proj] := fav_projs[poss_new_proj] + 1; (* adjust count for (to be) empty proj *) fav_projs[least_fav] := fav_projs[least_fav] + 1; (* adjust groups rating of previously favorite proj *) (* so procedures like (well like this proc) *) (* aren't fooled *) all_groups[group_numb].group_projs[least_fav] := 0; (* adjust favorite of group *) all_groups[group_numb].group_fav_proj := poss_new_proj; END ELSE BEGIN (* second choice didn't work *) (* debugging *) WRITELN('second choice proj didnt work, group',group_numb:3, 'not moved from project ',least_fav:3,' to project ', poss_new_proj:3,' which had ',fav_projs[poss_new_proj]:3, ' projects already'); (* eliminate highest rating and get next highest *) group_prefs[poss_new_proj] := 0; (*@c3@*) (* max4(group_prefs,poss_new_proj,rating); *) max5(group_prefs,poss_new_proj,rating); (* check if already full *) If fav_projs[poss_new_proj] < max_grps_4_one_proj THEN BEGIN (* room to add *) (* debugging *) WRITELN('third choice proj works, group',group_numb:3, 'moved from project ',least_fav:3,' to project ', poss_new_proj:3); (* adjust count for proj *) fav_projs[poss_new_proj] := fav_projs[poss_new_proj] + 1; (* adjust count for (to be) empty proj *) fav_projs[least_fav] := fav_projs[least_fav] + 1; (* adjust groups rating of previously favorite proj *) (* so procedures like (well like this proc) *) (* aren't fooled *) all_groups[group_numb].group_projs[least_fav] := 0; (* adjust favorite of group *) all_groups[group_numb].group_fav_proj := poss_new_proj; END ELSE BEGIN (* third choice didn't work *) (* Give up and just give top choice *) (* essentailly we just leave the same proj *) (* as favorite and let it be assigned *) WRITELN('coundnt find a project for group', group_numb:5); (* debugging *) WRITELN('third choice proj didnt work, group',group_numb:3, 'not moved from project ',least_fav:3,' to project ', poss_new_proj:3,' which had ',fav_projs[poss_new_proj]:3, ' projects already'); END; END; END; END; (* move_from_unpopular_projs *) (********************************************************************) (* Procedure: *) (* *) (* Function: *) (* *) (* *) (* Inputs: *) (* *) (* *) (* Outputs: *) (* *) (* *) (* Procedures: *) (* *) (* *) (* Functions: *) (* None. *) (* *) (********************************************************************) PROCEDURE largest_of_grps (group_list : group_list_typ; VAR number, value : INTEGER); VAR indices : rate_arr; temp : INTEGER; ii,jj : INTEGER; BEGIN (* initialize indices *) FOR ii := 1 TO max_groups DO indices[ii] := ii; FOR ii := 1 TO (max_groups - 1) DO BEGIN FOR jj := (ii + 1) TO max_groups DO BEGIN IF group_list[jj] > group_list[ii] THEN BEGIN (* swap list and indices *) temp := group_list[jj]; group_list[jj] := group_list[ii]; group_list[ii] := temp; (* keep track of which of the orginal elements is *) (* which *) temp := indices[jj]; indices[jj] := indices[ii]; indices[ii] := temp; END; END; END; number := indices[1]; value := group_list[1]; END; (* largest_of_grps *) (********************************************************************) (* Procedure: *) (* *) (* Function: *) (* *) (* *) (* Inputs: *) (* *) (* *) (* Outputs: *) (* *) (* *) (* Procedures: *) (* *) (* *) (* Functions: *) (* None. *) (* *) (********************************************************************) PROCEDURE smallest_of_grps (group_list : group_list_typ; curr_numb_groups : INTEGER; VAR number, value : INTEGER); VAR indices : rate_arr; temp : INTEGER; ii,jj : INTEGER; BEGIN WRITELN('In smallest_of_grps'); (* initialize indices *) FOR ii := 1 TO max_groups DO indices[ii] := ii; (* FOR ii := 1 TO (max_groups - 1) DO *) FOR ii := 1 TO (curr_numb_groups - 1) DO BEGIN (* FOR jj := (ii + 1) TO max_groups DO *) FOR jj := (ii + 1) TO curr_numb_groups DO BEGIN IF group_list[jj] < group_list[ii] THEN BEGIN (* swap list and indices *) temp := group_list[jj]; group_list[jj] := group_list[ii]; group_list[ii] := temp; (* keep track of which of the orginal elements is *) (* which *) temp := indices[jj]; indices[jj] := indices[ii]; indices[ii] := temp; END; END; END; number := indices[1]; value := group_list[1]; END; (* smallest_of_grps *) (********************************************************************) (* Procedure: *) (* *) (* Function: *) (* *) (* *) (* Inputs: *) (* *) (* *) (* Outputs: *) (* *) (* *) (* Procedures: *) (* *) (* *) (* Functions: *) (* None. *) (* *) (********************************************************************) (* need to move n groups to a different project where n *) (* is the difference between number of groups choosing a *) (* project and max number that I want to allow *) PROCEDURE move_from_popular_projs (VAR all_groups : group_arr; pot_groups_to_move : group_list_typ; VAR fav_projs : rate_arr; most_fav,most_fav_count : INTEGER; numb_grps_ass : INTEGER); VAR numb_groups_to_move : INTEGER; diff_first_to_sec_proj : group_list_typ; groups_to_move : group_list_typ; ii,jj : INTEGER; poss_new_proj : INTEGER; group_numb : INTEGER; group_prefs : rate_arr; proj_numb,highest_rate : INTEGER; smallest,small_val : INTEGER; rating : INTEGER; BEGIN WRITELN('In move_from_popular_projs'); (* determine how many groups need to be moved *) numb_groups_to_move := most_fav_count - max_grps_4_one_proj; (* find difference between first and second choice for *) (* all of potential groups to move *) (* debugging *) WRITELN('groups for popular proj: '); FOR ii := 1 TO most_fav_count DO BEGIN group_numb := pot_groups_to_move[ii]; (* debugging *) WRITE('group: ',group_numb:3); group_prefs := all_groups[group_numb].group_projs; (* find largest rating *) (* debugging *) WRITE(' prefs: '); FOR jj := 1 TO 4 DO BEGIN WRITE(group_prefs[jj]:5); END; (*@c3@*) (* max4(group_prefs,proj_numb,highest_rate); *) max5(group_prefs,proj_numb,highest_rate); (* eliminate highest rating and get next highest *) group_prefs[most_fav] := 0; (*@c3@*) (* max4(group_prefs,poss_new_proj,rating); *) max5(group_prefs,poss_new_proj,rating); (* get difference *) diff_first_to_sec_proj[ii] := highest_rate - rating; (* debugging *) WRITELN(' diff from first to sec: ',diff_first_to_sec_proj[ii]:5); END; (* debugging *) WRITELN; (* find n most small differences *) FOR ii := 1 TO numb_groups_to_move DO BEGIN smallest_of_grps(diff_first_to_sec_proj,most_fav_count, smallest,small_val); (* debugging *) WRITELN('position among potential groups to move ',smallest:3); WRITELN('group to move ',pot_groups_to_move[smallest]:3, ' (value ',small_val:4,')'); groups_to_move[ii] := pot_groups_to_move[smallest]; (* reset difference so get second smallest etc *) diff_first_to_sec_proj[smallest] := 9999; END; (* move n most small differences *) FOR ii := 1 TO numb_groups_to_move DO BEGIN group_numb := groups_to_move[ii]; group_prefs := all_groups[group_numb].group_projs; (* debugging *) WRITE('now moving group ',group_numb:3,' '); FOR jj := 1 TO 4 DO BEGIN WRITE(group_prefs[jj]:5); END; WRITELN; (* eliminate highest rating and get next highest *) group_prefs[most_fav] := 0; (*@c3@*) (* max4(group_prefs,poss_new_proj,rating); *) max5(group_prefs,poss_new_proj,rating); (* check if already full *) If fav_projs[poss_new_proj] < max_grps_4_one_proj THEN BEGIN (* room to add *) (* debugging *) WRITELN('second choice proj works, group',group_numb:3, 'moved from project ',most_fav:3,' to project ', poss_new_proj:3); (* adjust count for proj *) fav_projs[poss_new_proj] := fav_projs[poss_new_proj] + 1; (* adjust count for too full proj *) (* should this be most_fav instead of most_fav_count ? *) fav_projs[most_fav] := fav_projs[most_fav] - 1; (* adjust groups rating of previously favorite proj *) (* so procedures like (well like 1st loop of this proc) *) (* aren't fooled *) all_groups[group_numb].group_projs[most_fav] := 0; (* adjust favorite of group *) all_groups[group_numb].group_fav_proj := poss_new_proj; END ELSE BEGIN (* second choice didn't work *) (* debugging *) WRITELN('second choice proj didnt work, group',group_numb:3, 'not moved from project ',most_fav:3,' to project ', poss_new_proj:3,' which had ',fav_projs[poss_new_proj]:3, ' projects already'); (* eliminate highest rating and get next highest *) group_prefs[poss_new_proj] := 0; (*@c3@*) (* max4(group_prefs,poss_new_proj,rating); *) max5(group_prefs,poss_new_proj,rating); (* check if already full *) If fav_projs[poss_new_proj] < max_grps_4_one_proj THEN BEGIN (* room to add *) (* debugging *) WRITELN('third choice proj works, group',group_numb:3, 'moved from project ',most_fav:3,' to project ', poss_new_proj:3); (* adjust count for proj *) fav_projs[poss_new_proj] := fav_projs[poss_new_proj] + 1; (* adjust count for too full proj *) fav_projs[most_fav] := fav_projs[most_fav] - 1; (* adjust groups rating of previously favorite proj *) (* so procedures like (well like 1st loop of this proc) *) (* aren't fooled *) all_groups[group_numb].group_projs[most_fav] := 0; (* adjust favorite of group *) all_groups[group_numb].group_fav_proj := poss_new_proj; END ELSE BEGIN (* third choice didn't work *) (* Give up and just give top choice *) (* essentailly we just leave the same proj *) (* as favorite and let it be assigned *) WRITELN('coundnt find a project for group', group_numb:5); (* debugging *) WRITELN('third choice proj didnt work, group',group_numb:3, 'not moved from project ',most_fav:3,' to project ', poss_new_proj:3,' which had ',fav_projs[poss_new_proj]:3, ' projects already'); END; END; END; END; (* move_from_popular_projs *) (********************************************************************) (* Procedure: *) (* *) (* Function: *) (* *) (* *) (* Inputs: *) (* *) (* *) (* Outputs: *) (* *) (* *) (* Procedures: *) (* *) (* *) (* Functions: *) (* None. *) (* *) (********************************************************************) (* assign groups (already constructed) to projects *) PROCEDURE assign_projs (numb_studs : INTEGER; VAR all_studs : stud_arr; VAR all_groups : group_arr ; numb_grps_ass : INTEGER); VAR indx : INTEGER; fav_projs : rate_arr; least_fav, (* project favored by the fewest groups *) least_fav_count : INTEGER; most_fav, (* project favored by the fewest groups *) most_fav_count : INTEGER; groups_to_move, potential_groups_to_move : group_list_typ; projs_for_all : BOOLEAN; BEGIN WRITELN('In assign_projs'); projs_for_all := false; (* get ratings for projects for each group *) prep_assign_projs(numb_studs,all_groups,numb_grps_ass); (* keep going until everything ok *) WHILE (NOT projs_for_all) DO BEGIN (* count for each project number of groups it is the favorite of *) count_fav_projs (all_groups,fav_projs,numb_grps_ass); (* find least favorite and most favorite projs *) (*@c3@*) (* min4(fav_projs,least_fav,least_fav_count); *) min5(fav_projs,least_fav,least_fav_count); (*@c3@*) (* max4(fav_projs,most_fav,most_fav_count); *) max5(fav_projs,most_fav,most_fav_count); (* debugging *) WRITELN('favorite project ',most_fav:4, ' number groups ',most_fav_count:4); WRITELN('least favorite project ',least_fav:4, ' number groups ',least_fav_count:4); (* check to see if worked perfectly *) IF (least_fav_count = 0) AND (most_fav_count <= max_grps_4_one_proj) THEN BEGIN (* no problem, assign all to favorites *) (* set flag to allow exiting procedure *) projs_for_all := true; assign_to_fav_proj(all_groups,all_studs,numb_grps_ass); END ELSE BEGIN (* could be too many for most popular or some in least *) (* popular OR BOTH *) (* if just some in least popular, find projs for them *) (* if just too many in popular, find projs for least n *) (* picky groups *) (* if both, need to be careful, need to find projs for all *) IF least_fav_count <> 0 THEN BEGIN (* debugging *) WRITELN('moving from unpopular proj'); (* least fav is a prob - do first *) find_groups_for_proj_fav (all_groups, least_fav, groups_to_move, least_fav_count,numb_grps_ass); (* find groups second choice *) (* and put them in there *) move_from_unpopular_projs(all_groups,groups_to_move, fav_projs,least_fav,least_fav_count,numb_grps_ass); (***********************************************) (* changed to assign upon exiting since more than *) (* one problem may need to be corrected *) (* assign_to_fav_proj(all_groups,all_studs); *) END; IF most_fav_count > max_grps_4_one_proj THEN BEGIN (* most fav is a prob - do first *) (* debugging *) WRITELN('moving from popular proj'); find_groups_for_proj_fav (all_groups, most_fav, potential_groups_to_move, most_fav_count,numb_grps_ass); (* find groups second choice *) (* and put them in there *) move_from_popular_projs(all_groups, potential_groups_to_move, fav_projs,most_fav,most_fav_count,numb_grps_ass); (* may well need to loop around again if more than *) (* one proj got 4 or more groups picking it *) (***********************************************) (* changed to assign upon exiting since more than *) (* one problem may need to be corrected *) (* assign_to_fav_proj(all_groups,all_studs); *) END; END; END; (* while loop *) END; (* assign_projs *) (**************************************************************************) (**************************************************************************) (* looks like a copy of reset_assign that I was going to use for something*) (* PROCEDURE dont_know_what_for (all_groups : group_arr; *) (* group_number : INTEGER; *) (* VAR group_list : group_list_typ; *) (* VAR count : INTEGER); *) (* VAR *) (* indx : INTEGER; *) (* *) (* BEGIN *) (* FOR indx := 1 TO curr_numb_studs DO *) (* BEGIN *) (* WITH all_studs[indx] DO *) (* BEGIN *) (* group_ass := 0; *) (* proj_ass := 0; *) (* END; *) (* END; *) (* END; *)(* dont_know_what_for *) (**************************************************************************) (**************************************************************************) (********************************************************************) (* Procedure: *) (* *) (* Function: *) (* *) (* *) (* Inputs: *) (* *) (* *) (* Outputs: *) (* *) (* *) (* Procedures: *) (* *) (* *) (* Functions: *) (* None. *) (* *) (********************************************************************) (* create records for each group after groups have been assigned *) PROCEDURE create_group_recs (numb_studs : INTEGER; all_studs : stud_arr; VAR all_groups : group_arr ; numb_grps_ass : INTEGER); VAR group_indx,indx : INTEGER; group_numb,memb_numb : INTEGER; BEGIN FOR group_indx := 1 TO (*max_groups*) numb_grps_ass DO BEGIN all_groups[group_indx].group_numb := group_indx; all_groups[group_indx].group_memb_numb := 0; END; all_groups[(*max_groups*) numb_grps_ass + 1].group_numb := no_group_ass; FOR indx := 1 TO numb_studs DO BEGIN WITH all_studs[indx] DO BEGIN IF group_ass = no_group_ass THEN BEGIN (* dont save just count *) all_groups[(*max_groups*) numb_grps_ass + 1].group_memb_numb := all_groups[(*max_groups*) numb_grps_ass + 1].group_memb_numb + 1; END ELSE BEGIN (* regular group *) group_numb := group_ass; all_groups[group_numb].group_memb_numb := all_groups[group_numb].group_memb_numb + 1; memb_numb := all_groups[group_numb].group_memb_numb; (* move student record into approp place in group *) (* record *) all_groups[group_numb].group_membs[memb_numb] := all_studs[indx]; (* remember student number in student array so *) (* can get directly back to it *) WITH all_groups[group_numb].group_membs[memb_numb] DO BEGIN stud_numb := indx; END; (* remember it in student array too *) (* (probably superflous *) stud_numb := indx; END; END; END; END; (* create_group_recs *) (********************************************************************) (* Procedure: *) (* *) (* Function: *) (* *) (* *) (* Inputs: *) (* *) (* *) (* Outputs: *) (* *) (* *) (* Procedures: *) (* *) (* *) (* Functions: *) (* None. *) (* *) (********************************************************************) (* rate a group assignment *) (* also mark times that are ok or better for all members of group *) (* NOPE not done yet *) PROCEDURE rate_assign (VAR all_groups : group_arr; threshold : INTEGER; VAR total_rating : REAL; VAR all_studs : stud_arr ; numb_grps_ass : INTEGER); VAR proj_indx,memb_indx,time_indx,indx : INTEGER; time_ok : BOOLEAN; time_count, time_rate, sub_total, exper_rate : INTEGER; unassigned_cnt : INTEGER; total_proj : INTEGER; total_exper,max_exper,two_smaller_exper : INTEGER; BEGIN total_rating := 0; (* rate each groups liking of assigned project *) FOR indx := 1 TO (*max_groups*) numb_grps_ass DO BEGIN WITH all_groups[indx] DO BEGIN proj_indx := group_proj_ass; total_proj := 1; (* find total rating for a project for a group *) FOR memb_indx := 1 TO group_size DO BEGIN WITH group_membs[memb_indx] DO BEGIN total_proj := total_proj * (projs[proj_indx] * projs[proj_indx]); END; END; (* debugging *) WRITELN(' total rating for a project for a group ', total_proj:5, '(group ',indx:3,' project ',proj_indx:3,')'); (* total rating for a project for a group *) (* group_fav_proj_rate := total_proj; *) time_rate := 0; (* find all good times for group *) (* each contributes weight to group rating *) FOR time_indx := 1 TO numb_tim_slots DO BEGIN time_ok := true; time_count := 0; FOR memb_indx := 1 TO group_size DO BEGIN WITH group_membs[memb_indx] DO BEGIN IF times[time_indx] >= min_ok_4_rate THEN BEGIN (* if time rating is above cutoff *) (* add rating for the time *) time_count := time_count + times[time_indx]; (* mark time as compatible *) compat_times[time_indx] := times[time_indx]; END ELSE BEGIN (* indicate time not ok *) time_ok := false; (* mark time as incompatible *) compat_times[time_indx] := 0; END; END; END; (* if time slot is ok for all 3 add weight to assign *) (* also update compatible times part of stud record *) (* NOPE not done yet *) IF time_ok THEN BEGIN time_rate := time_rate + time_count; (* debugging *) WRITELN('time ',time_indx:3,' good for all ', 'members of group ',indx:3, ' ADD to time rating: ',time_count:3); END ELSE BEGIN (* go back and mark times as incompatible *) FOR memb_indx := 1 TO group_size DO BEGIN WITH group_membs[memb_indx] DO BEGIN (* mark time as incompatible *) compat_times[time_indx] := 0; END; END; END; END; sub_total := total_proj * time_rate; (* debugging *) WRITELN('total time contribution for group (', indx:3, ') ',time_rate:5,' Project * Time = ',sub_total:6); (* adjust for experience of group members *) max_exper := 0; total_exper := 0; FOR memb_indx := 1 TO group_size DO BEGIN WITH group_membs[memb_indx] DO BEGIN total_exper := total_exper + experience; IF experience > max_exper THEN BEGIN max_exper := experience; END; END; END; two_smaller_exper := (total_exper - max_exper); (* first term is to ensure val > 0 *) exper_rate := (max_exper_rate + 1) + (max_exper - two_smaller_exper); sub_total := sub_total * exper_rate; (* debugging *) WRITELN('Experience contribution for group (', indx:3, ') ',exper_rate:5,' (max_exper ',max_exper:2,')', ' (two_smaller_exper ',two_smaller_exper:3,')'); WRITELN('New Subtotal (Proj * Time * Exper): ',sub_total:6); total_rating := total_rating + sub_total; (* debugging *) WRITELN('New Total for All Groups So Far: ',total_rating:8:1); END; END; (* need penalty for unassigned *) unassigned_cnt := 0; FOR indx := 1 TO curr_numb_studs DO BEGIN WITH all_studs[indx] DO BEGIN IF (group_ass = 0) OR (group_ass = no_group_ass) THEN BEGIN unassigned_cnt := unassigned_cnt + 1; END; END; END; total_rating := total_rating - (unassigned_cnt * unass_penalty); (* debugging *) WRITELN('Number Students Unassigned: ',unassigned_cnt:3); WRITELN('Total Rating for group/project assignments: ',total_rating:16:2); WRITELN(debug,'Total Rating for group/project assignments: ',total_rating:16:2); WRITELN(results,'Total Rating for group/project assignments: ',total_rating:16:2); END; (* rate_assign *) (********************************************************************) (* Procedure: *) (* *) (* Function: *) (* *) (* *) (* Inputs: *) (* *) (* *) (* Outputs: *) (* *) (* *) (* Procedures: *) (* *) (* *) (* Functions: *) (* None. *) (* *) (********************************************************************) (* take compatible times info from group info and copy it to the student *) (* array where it can be used for printing the group assignments *) PROCEDURE update_compat_times_in_stud_arr (all_groups : group_arr; VAR all_studs : stud_arr; numb_grps_ass : INTEGER); VAR memb_indx,stud_indx,indx : INTEGER; BEGIN FOR indx := 1 TO (*max_groups*) numb_grps_ass DO BEGIN WITH all_groups[indx] DO BEGIN FOR memb_indx := 1 TO group_size DO BEGIN (* find corresponding student and assign compat times *) find_stud(group_membs[memb_indx],all_studs,stud_indx); WITH group_membs[memb_indx] DO BEGIN all_studs[stud_indx].compat_times := compat_times; END; END; END; END; END; (********************************************************************) (* Procedure: *) (* *) (* Function: *) (* *) (* *) (* Inputs: *) (* *) (* *) (* Outputs: *) (* *) (* *) (* Procedures: *) (* *) (* *) (* Functions: *) (* None. *) (* *) (********************************************************************) (* carry out process of assigning groups and projects and rating *) (* the assignment with a given threshold *) PROCEDURE process_with_threshold (VAR all_studs : stud_arr; VAR all_times : time_arr; VAR simple_times : time_arr_simple; VAR all_groups : group_arr; theshold : INTEGER; VAR assign_rating : REAL; VAR group_numb : INTEGER; all_time_codes : time_code_arr ); BEGIN WRITELN('calling count numb above thresh'); count_numb_abov_thresh(curr_numb_studs,all_studs,threshold); WRITELN('calling sort_by numb above thresh'); sort_by_numb_abov_thresh(curr_numb_studs,all_studs); (* reset times array to fit with sorted student array *) WRITELN('calling proc convert_dat'); convert_dat(curr_numb_studs,numb_tim_slots,all_studs,all_times,simple_times); WRITELN('calling print numb above thresh'); print_numb_abov_thresh(curr_numb_studs,all_studs,threshold); (* WRITELN('calling print_converted_dat'); *) (* print_converted_dat(curr_numb_studs,numb_tim_slots,all_studs,simple_times); *) WRITELN('calling print_converted_compres_dat'); print_converted_compres_dat(curr_numb_studs,numb_tim_slots, all_studs,simple_times,all_time_codes,threshold); group_numb := 1; REPEAT WRITELN('Going to assign'); assign(curr_numb_studs,all_studs,simple_times,threshold,group_numb); UNTIL all_studs_ass(all_studs,curr_numb_studs); (* make up for being ready for next group that never came *) group_numb := group_numb - 1; WRITELN('calling sort_by group assign'); sort_by_group_assign(curr_numb_studs,all_studs); (* WRITELN('calling print group assign'); *) (* print_group_assign(curr_numb_studs,all_studs,threshold); *) WRITELN('calling create_group_recs'); create_group_recs(curr_numb_studs,all_studs,all_groups,group_numb); WRITELN('calling assign_projs'); assign_projs(curr_numb_studs,all_studs,all_groups,group_numb); WRITELN('calling rate_assign'); rate_assign(all_groups,threshold,assign_rating,all_studs,group_numb); WRITELN('calling update_compat_times_in_stud_arr '); update_compat_times_in_stud_arr (all_groups, all_studs, group_numb); WRITELN('calling print group assign'); print_group_assign(curr_numb_studs,all_studs,threshold); WRITELN('calling print group assign_for_students'); print_group_assign_for_students(curr_numb_studs,all_studs,threshold, all_time_codes); END; (* main program *) begin WRITELN('Please enter the name of the student data file'); READLN(stud_file_name); (* ASSIGN(last_wk,old_file_name); *) open(studdat,stud_file_name,'old'); RESET(studdat); WRITELN('Please enter the name of the results data file'); READLN(results_file); (* ASSIGN(roto_res,results_file); *) open(results,results_file,'new'); REWRITE(results); (* ASSIGN(debug,'debug.txt'); *) open(debug,'debug.txt','new'); REWRITE(debug); open(fresults,'final-results','new'); REWRITE(fresults); WRITELN('calling proc init_time_code_arr'); init_time_code_arr (all_time_codes); WRITELN('calling proc read_dat '); read_dat(curr_numb_studs,all_studs,studdat); WRITELN('calling proc convert_dat'); convert_dat(curr_numb_studs,numb_tim_slots,all_studs,all_times,simple_times); (* WRITELN('calling print_converted_dat'); *) (* print_converted_dat(curr_numb_studs,numb_tim_slots,all_studs,simple_times); *) threshold := 5; WRITELN('calling process_with_threshold with theshold = 5'); process_with_threshold (all_studs, all_times, simple_times, all_groups, threshold, assign_rating, numb_groups_assigned, all_time_codes ); WRITELN('calling reset assign'); reset_assign(curr_numb_studs,all_studs); threshold := 4; WRITELN('calling process_with_threshold with theshold = 4'); process_with_threshold (all_studs, all_times, simple_times, all_groups, threshold, assign_rating , numb_groups_assigned, all_time_codes); WRITELN('calling reset assign'); reset_assign(curr_numb_studs,all_studs); threshold := 3; WRITELN('calling process_with_threshold with theshold = 3'); process_with_threshold (all_studs, all_times, simple_times, all_groups, threshold, assign_rating , numb_groups_assigned, all_time_codes); WRITELN('calling reset assign'); reset_assign(curr_numb_studs,all_studs); END.