admincreatepaper3.asp

基于asp的遗传算法组卷系统

<%@LANGUAGE="VBSCRIPT" CODEPAGE="936"%>
<!--#include file="conn.inc"-->

<%'//遗传算法生成试题
'Option Explicit

function ran_n(rn,maxrn)'随机数写入临时数组
  ren_temp=""
  for j=1 to maxrn'生成全“0”数列
    ren_temp=ren_temp&"0"
  next
  for j=1 to rn
    call m_ran(rn,maxrn)  
  next
  ran_n = ren_temp
  'response.Write (ren_temp)
end function

function m_ran(rn,maxrn)'产生随机数并组合生成串
  randomize
  dim rando_num
  rando_num=fix(maxrn*rnd +1)
  if right(left(ren_temp,rando_num),1)=1 then
     call m_ran(rn,maxrn)
  else
     ren_temp=left(ren_temp,rando_num-1)&"1"&right(ren_temp,len(ren_temp)-rando_num)
  end if
end function

function suit()'适应度计算涵数
  dim suit_t1_1,suit_t1_2,suit_t1_3,suit_t1_4,suit_t1_5,suit_t2,suit_t3,suit_t3_total,suit_t4,suit_t5'章节1,章节2,章节3,章节4,章节5,难度，区分度,总分，现时间,总区分度
  for i=0 to group-1
	suit_t1_1 = 0
	suit_t1_2 = 0
	suit_t1_3 = 0
	suit_t1_4 = 0
	suit_t1_5 = 0
	suit_t2 = 0
	suit_t3 = 0
	suit_t3_total = 0
	suit_t4 = 0
	suit_t5 = 0
    ren_temp = encode(i,1)'单选
    rs_type.Open sql_type1,conn,3,1
    for j=1 to len(ren_temp)
      if right(left(ren_temp,j),1)=1 then
        'response.Write (rs_type.Fields ("ID")&"<br>")'检验是否命中“1”的题目
        select case rs_type.Fields ("chapt")
          case 1
            suit_t1_1 = suit_t1_1+1
          case 2
            suit_t1_2 = suit_t1_2+1
          case 3
            suit_t1_3 = suit_t1_3+1
          case 4
            suit_t1_4 = suit_t1_4+1
          case 5
            suit_t1_5 = suit_t1_5+1
        end select
        suit_t2 = suit_t2+abs(total_nd-rs_type.Fields ("nandu"))
        suit_t3 = suit_t3+(rs_type.Fields ("qufendu")*rs_type.Fields ("fenzhi"))
        suit_t3_total = suit_t3_total+rs_type.Fields ("fenzhi")
        suit_t4 = suit_t4+rs_type.Fields ("shijian")
        suit_t5 = suit_t5+abs(rs_type.Fields ("qufendu")-total_qfd)
      end if
      rs_type.MoveNext      
    next    
    rs_type.Close
    ren_temp = encode(i,2)'多选
    rs_type.Open sql_type2,conn,3,1
    for j=1 to len(ren_temp)
      if right(left(ren_temp,j),1)=1 then
        'response.Write (rs_type.Fields ("ID")&"<br>")'检验是否命中“1”的题目
        select case rs_type.Fields ("chapt")
          case 1
            suit_t1_1 = suit_t1_1+1
          case 2
            suit_t1_2 = suit_t1_2+1
          case 3
            suit_t1_3 = suit_t1_3+1
          case 4
            suit_t1_4 = suit_t1_4+1
          case 5
            suit_t1_5 = suit_t1_5+1
        end select
        suit_t2 = suit_t2+abs(total_nd-rs_type.Fields ("nandu"))
        suit_t3 = suit_t3+(rs_type.Fields ("qufendu")*rs_type.Fields ("fenzhi"))
        suit_t3_total = suit_t3_total+rs_type.Fields ("fenzhi")
        suit_t4 = suit_t4+rs_type.Fields ("shijian")
        suit_t5 = suit_t5+abs(rs_type.Fields ("qufendu")-total_qfd)
      end if
      rs_type.MoveNext      
    next    
    rs_type.Close
    ren_temp = encode(i,3)'判断
    rs_type.Open sql_type3,conn,3,1
    for j=1 to len(ren_temp)
      if right(left(ren_temp,j),1)=1 then
        'response.Write (rs_type.Fields ("ID")&"<br>")'检验是否命中“1”的题目
        select case rs_type.Fields ("chapt")
          case 1
            suit_t1_1 = suit_t1_1+1
          case 2
            suit_t1_2 = suit_t1_2+1
          case 3
            suit_t1_3 = suit_t1_3+1
          case 4
            suit_t1_4 = suit_t1_4+1
          case 5
            suit_t1_5 = suit_t1_5+1
        end select
        suit_t2 = suit_t2+abs(total_nd-rs_type.Fields ("nandu"))
        suit_t3 = suit_t3+(rs_type.Fields ("qufendu")*rs_type.Fields ("fenzhi"))
        suit_t3_total = suit_t3_total+rs_type.Fields ("fenzhi")
        suit_t4 = suit_t4+rs_type.Fields ("shijian")    
        suit_t5 = suit_t5+abs(rs_type.Fields ("qufendu")-total_qfd)    
      end if
      rs_type.MoveNext      
    next    
    rs_type.Close
    encode(i,4) = (abs(suit_t1_1-zj1_num)+abs(suit_t1_2-zj2_num)+abs(suit_t1_3-zj3_num)+abs(suit_t1_4-zj4_num)+abs(suit_t1_5-zj5_num))*zj_q'题数计算
    encode(i,4) = encode(i,4)+(suit_t2*nd_q)'难度计算
    encode(i,4) = encode(i,4)+(suit_t3/suit_t3_total*qu_q)'区分度计算
    encode(i,4) = encode(i,4)+(abs(suit_t4-total_time)*time_q)'时间计算
  next
end function

function ch()'选择排序  
  dim group_new'下一代群大小
  const M=10000
  group_new = group\2'按50%比例筛选  
  if not (group_new mod 2)=0 then group_new = group_new-1
  'response.Write ("group_new:"&group_new)
  redim encode_temp(group_new-1,4)
  dim temp(1)
  temp(1) = M
  for i=0 to group_new-1
    for j=0 to group-1
      if encode(j,4)<temp(1) then
        temp(0) = j
        temp(1) = encode(j,4)   
      end if      
    next 
    encode_temp(i,0) = i+1
    encode_temp(i,1) = encode(temp(0),1)
    encode_temp(i,2) = encode(temp(0),2)
    encode_temp(i,3) = encode(temp(0),3)
    encode_temp(i,4) = encode(temp(0),4)
    encode(temp(0),4) = M'给予足够大的数让它退出排序
    temp(1) = M
  next
  group = group_new
  redim encode(group-1,4)
  for i=0 to group-1
    for j=0 to 4
      encode(i,j) = encode_temp(i,j)
    next    
  next
  gen = gen+1'增加当前代数
end function

function ran_m()'产生随即不重复数列1
  'dim num
  ren_temp = rando(0,group-1)
  if encode(ren_temp,0)=0 then
    call ran_m()    
  end if
end function

function cross()'交叉涵数
  dim pc,pc_i'pc为交叉概率pc_i为交叉点
  'dim temp_1,temp_2,temp_s
  dim r_temp
  for i=0 to group-1
    r_temp = rando(0,group-1)
    do while encode(r_temp,0)=0  '随机交换占用较大时间，有代改进----------------------经计算大约经过300次运算（当循环25次时）  
      if r_temp = group-1 then
        r_temp = 0
      else
        r_temp = r_temp+1
      end if           
    loop
    encode_temp(i,0)=encode(r_temp,0)
    encode_temp(i,1)=encode(r_temp,1)
    encode_temp(i,2)=encode(r_temp,2)
    encode_temp(i,3)=encode(r_temp,3)
    encode_temp(i,4)=encode(r_temp,4)
    encode(r_temp,0)=0
    'response.Write (r_temp&"|")
  next
  '\\两个串开始交叉
  'response.Write (group/2-1)
  for i=0 to group/2-1    
    encode(i*2,0)=i*2+1
    encode(i*2+1,0)=i*2+2
    encode(i*2,1)=encode_temp(i*2,1)
    encode(i*2+1,1)=encode_temp(i*2+1,1)
    for j=1 to 2
      encode(i*2,j+1)=encode_temp(i*2,j+1)
      encode(i*2+1,j+1)=encode_temp(i*2+1,j+1)        
    next
    randomize
    pc=rnd
    'response.Write ("-"&pc)
    if pc>0.4 and pc<0.9 then
      pc_i=rando(1,2)'从第几组题目开始互换(共3种题故互换可能只有两种)
      'response.Write("+"&pc_i)
      for j=pc_i to 2
        encode(i*2,j+1)=encode_temp(i*2+1,j+1)
        encode(i*2+1,j+1)=encode_temp(i*2,j+1)        
      next
    end if
    'response.Write ("*"&i)
  next
end function

function rando(min,max)'产生随机整数涵数
  randomize
  rando = fix(max*rnd+min)
end function

function variety()
  dim t_num,pm,pm_i'pm为突边概率，pm_i为要变化的位置
  t_num = type_num1+type_num2+type_num3
  for i=0 to group-1
    randomize
    pm=rnd
    if pm<0.1 then      
      pm_i=rando(1,t_num)
      'response.Write ("}"&i&"+"&pm_i)
      if pm_i<=type_num1 then
        ren_temp=encode(i,1)
        call variety01(pm_i)
        encode(i,1)=ren_temp
      elseif pm_i>type_num1 and pm_i<=type_num1+type_num2 then
        ren_temp=encode(i,2)
        pm_i=pm_i-type_num1
        call variety01(pm_i)
        encode(i,2)=ren_temp
      elseif pm_i>type_num1+type_num2 and pm_i<=t_num then
        ren_temp=encode(i,3)
        pm_i=pm_i-type_num1-type_num2
        call variety01(pm_i)
        encode(i,3)=ren_temp
      end if
    end if
  next
end function

function variety01(pm_i)'ren_temp为要边异的串
  dim check01
  check01 = right(left(ren_temp,pm_i),1)
  if check01=0 then
    ren_temp=left(ren_temp,pm_i-1)&"1"&right(ren_temp,len(ren_temp)-pm_i)
    '//修正,补0
    call variety0()
  elseif check01=1 then