Index: openacs-4/packages/assessment/tcl/as-item-type-mc-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/assessment/tcl/as-item-type-mc-procs.tcl,v
diff -u -r1.27 -r1.27.2.1
--- openacs-4/packages/assessment/tcl/as-item-type-mc-procs.tcl 7 Aug 2017 23:48:03 -0000 1.27
+++ openacs-4/packages/assessment/tcl/as-item-type-mc-procs.tcl 14 Feb 2019 16:15:01 -0000 1.27.2.1
@@ -28,14 +28,14 @@
db_transaction {
set item_item_type_mc_id [content::item::new -parent_id $folder_id -content_type {as_item_type_mc} -name [as::item::generate_unique_name]]
set as_item_type_mc_id [content::revision::new \
- -item_id $item_item_type_mc_id \
- -content_type {as_item_type_mc} \
- -title $title \
- -attributes [list [list increasing_p $increasing_p] \
- [list allow_negative_p $allow_negative_p] \
- [list num_correct_answers $num_correct_answers] \
- [list num_answers $num_answers] \
- [list allow_other_p $allow_other_p] ] ]
+ -item_id $item_item_type_mc_id \
+ -content_type {as_item_type_mc} \
+ -title $title \
+ -attributes [list [list increasing_p $increasing_p] \
+ [list allow_negative_p $allow_negative_p] \
+ [list num_correct_answers $num_correct_answers] \
+ [list num_answers $num_answers] \
+ [list allow_other_p $allow_other_p] ] ]
}
return $as_item_type_mc_id
@@ -57,16 +57,16 @@
} {
# Update as_item_type_mc in the CR (and as_item_type_mc table) getting the revision_id (as_item_type_id)
db_transaction {
- set type_item_id [db_string type_item_id {}]
+ set type_item_id [db_string type_item_id {}]
set new_item_type_id [content::revision::new \
- -item_id $type_item_id \
- -content_type {as_item_type_mc} \
- -title $title \
- -attributes [list [list increasing_p $increasing_p] \
- [list allow_negative_p $allow_negative_p] \
- [list num_correct_answers $num_correct_answers] \
- [list num_answers $num_answers] \
- [list allow_other_p $allow_other_p] ] ]
+ -item_id $type_item_id \
+ -content_type {as_item_type_mc} \
+ -title $title \
+ -attributes [list [list increasing_p $increasing_p] \
+ [list allow_negative_p $allow_negative_p] \
+ [list num_correct_answers $num_correct_answers] \
+ [list num_answers $num_answers] \
+ [list allow_other_p $allow_other_p] ] ]
}
return $new_item_type_id
@@ -83,23 +83,23 @@
} {
# Update as_item_type_mc in the CR (and as_item_type_mc table) getting the revision_id (as_item_type_id)
db_transaction {
- db_1row item_type_data {}
+ db_1row item_type_data {}
set new_item_type_id [content::revision::new \
- -item_id $type_item_id \
- -content_type {as_item_type_mc} \
- -title $title \
- -attributes [list [list increasing_p $increasing_p] \
- [list allow_negative_p $allow_negative_p] \
- [list num_correct_answers $num_correct_answers] \
- [list num_answers $num_answers] \
- [list allow_other_p $allow_other_p] ] ]
+ -item_id $type_item_id \
+ -content_type {as_item_type_mc} \
+ -title $title \
+ -attributes [list [list increasing_p $increasing_p] \
+ [list allow_negative_p $allow_negative_p] \
+ [list num_correct_answers $num_correct_answers] \
+ [list num_answers $num_answers] \
+ [list allow_other_p $allow_other_p] ] ]
- if {$with_choices_p == "t"} {
- set choices [db_list get_choices {}]
- foreach choice_id $choices {
- set new_choice_id [as::item_choice::new_revision -choice_id $choice_id -mc_id $new_item_type_id]
- }
- }
+ if {$with_choices_p == "t"} {
+ set choices [db_list get_choices {}]
+ foreach choice_id $choices {
+ set new_choice_id [as::item_choice::new_revision -choice_id $choice_id -mc_id $new_item_type_id]
+ }
+ }
}
return $new_item_type_id
@@ -120,24 +120,24 @@
# Insert as_item_type_mc in the CR (and as_item_type_mc table) getting the revision_id (as_item_type_id)
db_transaction {
- db_1row item_type_data {}
+ db_1row item_type_data {}
if {[info exists new_title]} {
- set title $new_title
- }
- if {[string is false $copy_correct_answer_p]} {
- set num_correct_answers 0
- }
- set new_item_type_id [new -title $title \
- -increasing_p $increasing_p \
- -allow_negative_p $allow_negative_p \
- -num_correct_answers $num_correct_answers \
- -num_answers $num_answers \
+ set title $new_title
+ }
+ if {[string is false $copy_correct_answer_p]} {
+ set num_correct_answers 0
+ }
+ set new_item_type_id [new -title $title \
+ -increasing_p $increasing_p \
+ -allow_negative_p $allow_negative_p \
+ -num_correct_answers $num_correct_answers \
+ -num_answers $num_answers \
-allow_other_p $allow_other_p]
- set choices [db_list get_choices {}]
- foreach choice_id $choices {
- set new_choice_id [as::item_choice::copy -choice_id $choice_id -mc_id $new_item_type_id -copy_correct_answer_p $copy_correct_answer_p]
- }
+ set choices [db_list get_choices {}]
+ foreach choice_id $choices {
+ set new_choice_id [as::item_choice::copy -choice_id $choice_id -mc_id $new_item_type_id -copy_correct_answer_p $copy_correct_answer_p]
+ }
}
return $new_item_type_id
@@ -157,52 +157,52 @@
Render a Multiple Choice Type
} {
set allow_other_p [as::item_type_mc::allow_other_p -item_type_id $type_id]
-
+
set defaults ""
if {$default_value ne ""} {
array set values $default_value
- set defaults $values(choice_answer)
+ set defaults $values(choice_answer)
if {$allow_other_p} {
set defaults [list $defaults $values(clob_answer)]
}
}
if {$session_id ne ""} {
- if {$show_feedback eq "" || $show_feedback eq "none"} {
- set choice_list ""
- db_foreach get_sorted_choices {} {
- if {$content_value ne ""} {
- db_1row get_content_value ""
- set title [as::assessment::display_content -content_id $content_rev_id -filename $content_filename -content_type $content_type -title $title]
- }
- lappend choice_list [list $title $choice_id]
- }
- } else {
- # incorrect correct
- set choice_list ""
+ if {$show_feedback eq "" || $show_feedback eq "none"} {
+ set choice_list ""
+ db_foreach get_sorted_choices {} {
+ if {$content_value ne ""} {
+ db_1row get_content_value ""
+ set title [as::assessment::display_content -content_id $content_rev_id -filename $content_filename -content_type $content_type -title $title]
+ }
+ lappend choice_list [list $title $choice_id]
+ }
+ } else {
+ # incorrect correct
+ set choice_list ""
- db_foreach get_sorted_choices_with_feedback {} {
- if {$content_value ne ""} {
- db_1row get_content_value ""
- set title [as::assessment::display_content -content_id $content_rev_id -filename $content_filename -content_type $content_type -title $title]
- }
- set pos [lsearch -exact $defaults $choice_id]
- if {$pos>-1 && $correct_answer_p == "t" && $show_feedback ne "incorrect"} {
- lappend choice_list [list "$title 
$feedback_text" $choice_id]
- } elseif {$pos>-1 && $correct_answer_p == "f" && $show_feedback ne "correct"} {
- lappend choice_list [list "$title 
$feedback_text" $choice_id]
- } else {
- if {[llength $defaults] && $correct_answer_p == "t" && $show_feedback ne "incorrect" && $show_feedback ne "correct"} {
- lappend choice_list [list "$title " $choice_id]
- } else {
- lappend choice_list [list $title $choice_id]
- }
- }
- }
- }
-
- if {[llength $choice_list] > 0} {
- return [list $defaults $choice_list]
- }
+ db_foreach get_sorted_choices_with_feedback {} {
+ if {$content_value ne ""} {
+ db_1row get_content_value ""
+ set title [as::assessment::display_content -content_id $content_rev_id -filename $content_filename -content_type $content_type -title $title]
+ }
+ set pos [lsearch -exact $defaults $choice_id]
+ if {$pos>-1 && $correct_answer_p == "t" && $show_feedback ne "incorrect"} {
+ lappend choice_list [list "$title $feedback_text" $choice_id]
+ } elseif {$pos>-1 && $correct_answer_p == "f" && $show_feedback ne "correct"} {
+ lappend choice_list [list "$title $feedback_text" $choice_id]
+ } else {
+ if {[llength $defaults] && $correct_answer_p == "t" && $show_feedback ne "incorrect" && $show_feedback ne "correct"} {
+ lappend choice_list [list "$title " $choice_id]
+ } else {
+ lappend choice_list [list $title $choice_id]
+ }
+ }
+ }
+ }
+
+ if {[llength $choice_list] > 0} {
+ return [list $defaults $choice_list]
+ }
}
db_1row item_type_data {}
@@ -212,108 +212,108 @@
set wrong_choices [list]
set total 0
db_foreach choices {} {
- incr total
- if {$content_value ne ""} {
- db_1row get_content_value ""
- set title [as::assessment::display_content -content_id $content_rev_id -filename $content_filename -content_type $content_type -title $title]
- }
- if {$show_feedback ne "" && $show_feedback ne "none"} {
- set pos [lsearch -exact $defaults $choice_id]
- if {$pos > -1 && $correct_answer_p == "t" && $show_feedback ne "incorrect"} {
- lappend display_choices [list "$title $feedback_text" $choice_id]
- } elseif {$pos>-1 && $correct_answer_p == "f" && $show_feedback ne "correct"} {
- lappend display_choices [list "$title $feedback_text" $choice_id]
- } else {
- if {$correct_answer_p == "t" && $show_feedback ne "incorrect" && $show_feedback ne "correct"} {
- lappend display_choices [list "$title " $choice_id]
- } else {
- lappend display_choices [list $title $choice_id]
- }
- }
- } else {
- lappend display_choices [list $title $choice_id]
- }
-
-# lappend display_choices [list $title $choice_id]
- if {$selected_p == "t"} {
- lappend defaults $choice_id
- }
- if {$fixed_position ne ""} {
- set fixed_pos($fixed_position) [list $title $choice_id]
- if {$num_answers ne ""} {
- incr num_answers -1
- }
- if {$correct_answer_p == "t" && $num_correct_answers ne ""} {
- incr num_correct_answers -1
- }
- } else {
- if {$correct_answer_p == "t"} {
- lappend correct_choices [list $title $choice_id]
- } else {
- lappend wrong_choices [list $title $choice_id]
- }
- }
+ incr total
+ if {$content_value ne ""} {
+ db_1row get_content_value ""
+ set title [as::assessment::display_content -content_id $content_rev_id -filename $content_filename -content_type $content_type -title $title]
+ }
+ if {$show_feedback ne "" && $show_feedback ne "none"} {
+ set pos [lsearch -exact $defaults $choice_id]
+ if {$pos > -1 && $correct_answer_p == "t" && $show_feedback ne "incorrect"} {
+ lappend display_choices [list "$title $feedback_text" $choice_id]
+ } elseif {$pos>-1 && $correct_answer_p == "f" && $show_feedback ne "correct"} {
+ lappend display_choices [list "$title $feedback_text" $choice_id]
+ } else {
+ if {$correct_answer_p == "t" && $show_feedback ne "incorrect" && $show_feedback ne "correct"} {
+ lappend display_choices [list "$title " $choice_id]
+ } else {
+ lappend display_choices [list $title $choice_id]
+ }
+ }
+ } else {
+ lappend display_choices [list $title $choice_id]
+ }
+
+ # lappend display_choices [list $title $choice_id]
+ if {$selected_p == "t"} {
+ lappend defaults $choice_id
+ }
+ if {$fixed_position ne ""} {
+ set fixed_pos($fixed_position) [list $title $choice_id]
+ if {$num_answers ne ""} {
+ incr num_answers -1
+ }
+ if {$correct_answer_p == "t" && $num_correct_answers ne ""} {
+ incr num_correct_answers -1
+ }
+ } else {
+ if {$correct_answer_p == "t"} {
+ lappend correct_choices [list $title $choice_id]
+ } else {
+ lappend wrong_choices [list $title $choice_id]
+ }
+ }
}
if {[array exists fixed_pos]} {
- if {$num_answers eq ""} {
- set num_answers [expr {[llength $correct_choices] + [llength $wrong_choices]}]
- }
- if {$num_correct_answers eq ""} {
- set num_correct_answers [llength $correct_choices]
- }
+ if {$num_answers eq ""} {
+ set num_answers [expr {[llength $correct_choices] + [llength $wrong_choices]}]
+ }
+ if {$num_correct_answers eq ""} {
+ set num_correct_answers [llength $correct_choices]
+ }
}
if {$num_answers ne "" && $num_answers < $total} {
- # display fewer choices, select random
- set correct_choices [util::randomize_list $correct_choices]
- set wrong_choices [util::randomize_list $wrong_choices]
+ # display fewer choices, select random
+ set correct_choices [util::randomize_list $correct_choices]
+ set wrong_choices [util::randomize_list $wrong_choices]
- if {$num_correct_answers ne "" && $num_correct_answers > 0 && $num_correct_answers < [llength $correct_choices]} {
- # display fewer correct answers than there are
- set display_choices [lrange $correct_choices 1 $num_correct_answers]
- } else {
- # display all correct answers
- set display_choices $correct_choices
- }
+ if {$num_correct_answers ne "" && $num_correct_answers > 0 && $num_correct_answers < [llength $correct_choices]} {
+ # display fewer correct answers than there are
+ set display_choices [lrange $correct_choices 1 $num_correct_answers]
+ } else {
+ # display all correct answers
+ set display_choices $correct_choices
+ }
- # now fill up with wrong answers
- set display_choices [concat $display_choices [lrange $wrong_choices 0 [expr $num_answers - [llength $display_choices] -1]]]
- set display_choices [util::randomize_list $display_choices]
+ # now fill up with wrong answers
+ set display_choices [concat $display_choices [lrange $wrong_choices 0 [expr $num_answers - [llength $display_choices] -1]]]
+ set display_choices [util::randomize_list $display_choices]
}
# now add fixed positions in result list
if {[array exists fixed_pos]} {
- set max_pos [expr {$num_answers + [array size fixed_pos]}]
- set open_positions $display_choices
- set display_choices [list]
+ set max_pos [expr {$num_answers + [array size fixed_pos]}]
+ set open_positions $display_choices
+ set display_choices [list]
- for {set position 1} {$position <= $max_pos} {incr position} {
- if {[info exists fixed_pos($position)]} {
- lappend display_choices $fixed_pos($position)
- array unset fixed_pos $position
- } elseif {[llength $open_positions] > 0} {
- lappend display_choices [lindex $open_positions 0]
- set open_positions [lreplace $open_positions 0 0]
- }
- }
- # set negative fixed positions relative to the end of the choice list
- if {[array exists fixed_pos]} {
- foreach position [lsort -integer [array names fixed_pos]] {
- if {$position < 0} {
- lappend display_choices $fixed_pos($position)
- }
- }
- }
+ for {set position 1} {$position <= $max_pos} {incr position} {
+ if {[info exists fixed_pos($position)]} {
+ lappend display_choices $fixed_pos($position)
+ array unset fixed_pos $position
+ } elseif {[llength $open_positions] > 0} {
+ lappend display_choices [lindex $open_positions 0]
+ set open_positions [lreplace $open_positions 0 0]
+ }
+ }
+ # set negative fixed positions relative to the end of the choice list
+ if {[array exists fixed_pos]} {
+ foreach position [lsort -integer [array names fixed_pos]] {
+ if {$position < 0} {
+ lappend display_choices $fixed_pos($position)
+ }
+ }
+ }
}
# save choice order
if {$session_id ne ""} {
- set count 0
- foreach one_choice $display_choices {
- lassign $one_choice title choice_id
- incr count
- db_dml save_order {}
- }
+ set count 0
+ foreach one_choice $display_choices {
+ lassign $one_choice title choice_id
+ incr count
+ db_dml save_order {}
+ }
}
return [list $defaults $display_choices]
@@ -339,36 +339,36 @@
array set type [util_memoize [list as::item_type_mc::data -type_id $type_id]]
array set choices $type(choices)
if {[info exists type(correct_choices)]} {
- array set correct_choices $type(correct_choices)
+ array set correct_choices $type(correct_choices)
}
if {$type(increasing_p) == "t"} {
- # if not all correct answers are given, award fraction of the points
- set percent 0
- foreach choice_id $response {
- incr percent $choices($choice_id)
- }
+ # if not all correct answers are given, award fraction of the points
+ set percent 0
+ foreach choice_id $response {
+ incr percent $choices($choice_id)
+ }
} else {
- # award 100% points if and only if all correct answers are given
- set count_correct 0
- if {[array exists correct_choices] && [lsort -integer $response] == [lsort -integer [array names correct_choices]]} {
- set points $max_points
- } elseif {[array size correct_choices] > 0} {
- # FIXME !! create setting for partial credit or use existing one
- foreach elm $response {
- if {[lsearch [array names correct_choices] $elm] > -1} {
- incr count_correct
- }
- }
- set points [expr {$count_correct / (0.0 + [array size correct_choices]) * $max_points}]
- } else {
- set points 0
- }
+ # award 100% points if and only if all correct answers are given
+ set count_correct 0
+ if {[array exists correct_choices] && [lsort -integer $response] == [lsort -integer [array names correct_choices]]} {
+ set points $max_points
+ } elseif {[array size correct_choices] > 0} {
+ # FIXME !! create setting for partial credit or use existing one
+ foreach elm $response {
+ if {[lsearch [array names correct_choices] $elm] > -1} {
+ incr count_correct
+ }
+ }
+ set points [expr {$count_correct / (0.0 + [array size correct_choices]) * $max_points}]
+ } else {
+ set points 0
+ }
}
if {$type(allow_negative_p) == "f" && $points < 0} {
- # don't allow negative percentage
- set points 0
+ # don't allow negative percentage
+ set points 0
}
if {$type(allow_other_p)} {
@@ -394,15 +394,15 @@
db_1row item_type_data {} -column_array type
db_foreach check_choices {} {
- if {$correct_answer_p == "t"} {
- set correct_choices($choice_id) $percent_score
- }
- set choices($choice_id) $percent_score
+ if {$correct_answer_p == "t"} {
+ set correct_choices($choice_id) $percent_score
+ }
+ set choices($choice_id) $percent_score
}
set type(choices) [array get choices]
if {[array exists correct_choices]} {
- set type(correct_choices) [array get correct_choices]
+ set type(correct_choices) [array get correct_choices]
}
return [array get type]
@@ -419,28 +419,28 @@
Return the results of a given item in a given list of sessions as an array
} {
-
+
db_foreach get_results {} {
- if {$text_value eq ""} {
- lappend results($session_id) [as::assessment::quote_export -text $title]
- } else {
- lappend results($session_id) [as::assessment::quote_export -text $text_value]
- }
+ if {$text_value eq ""} {
+ lappend results($session_id) [as::assessment::quote_export -text $title]
+ } else {
+ lappend results($session_id) [as::assessment::quote_export -text $text_value]
+ }
}
foreach session_id [array names results] {
- set results($session_id) [join $results($session_id) ","]
+ set results($session_id) [join $results($session_id) ","]
}
if {[array exists results]} {
- return [array get results]
+ return [array get results]
} else {
- return
+ return
}
}
ad_proc -private as::item_type_mc::add_choices_to_form {
- -form_id
+ -form_id
-num_choices
-choice_array_name
-correct_choice_array_name
@@ -469,7 +469,7 @@
} else {
ad_form -extend -name $form_id -form [list [list choice.$i:text,optional,nospell {label "[_ assessment.Choice] $i"} {html {style {width: 80%;} maxlength 1000}}]]
}
-
+
if {[info exists correct($i)]} {
ad_form -extend -name $form_id -form [list [list correct.$i:text(checkbox),optional {label "[_ assessment.Correct_Answer_Choice] $i"} {options $correct_options} {values t }]]
} else {
@@ -491,7 +491,7 @@
{-allow_negative_p "f"}
{-allow_other_p "f"}
} {
- Add the multiple choice item to an assessment. The creates the
+ Add the multiple choice item to an assessment. The creates the
as_item_type_mc object and all the choices and associates the as_item_id
with an assessment, or updates the assessment with the latest version
@@ -519,23 +519,23 @@
}
foreach c [array names correct] {
if {$correct($c) == "t"} {
- incr num_correct_answers
+ incr num_correct_answers
}
}
-
+
if {![as::item::get_item_type_info -as_item_id $as_item_id] \
- || $item_type_info(object_type) ne "as_item_type_mc"} {
- # always set mc title to empty on new mc question
- # we ask for a title for the mc answer set separately if
- # required
+ || $item_type_info(object_type) ne "as_item_type_mc"} {
+ # always set mc title to empty on new mc question
+ # we ask for a title for the mc answer set separately if
+ # required
set mc_id [as::item_type_mc::new \
-title $title \
-increasing_p $increasing_p \
-allow_negative_p $allow_negative_p \
-num_correct_answers $num_correct_answers \
-num_answers $num_answers \
-allow_other_p $allow_other_p]
-
+
if {![info exists item_type_info(object_type)]} {
# first item type mapped
as::item_rels::new -item_rev_id $as_item_id -target_rev_id $mc_id -type as_item_type_rel
@@ -553,7 +553,7 @@
-allow_negative_p $allow_negative_p \
-num_correct_answers $num_correct_answers \
-num_answers $num_answers]
-
+
as::item::update_item_type -item_type_id $mc_id -as_item_id $as_item_id
}
@@ -593,15 +593,15 @@
}
ad_proc -private as::item_type_mc::add_existing_choices_to_edit_form {
- -form_id
+ -form_id
-existing_choices
-choice_array_name
-correct_choice_array_name
} {
Add form elements for multiple choice question choices
@param form_id Form builder form_id of the form to add the elements to. Error if form does not exist
- @param num_choices Number of choice form elements to add
+ @param existing_choices Choice form elements to add
@param choice_array_name Name of array in callers scope to look for existing choices
@param correct_choice_array_name Name of array in the caller's scope to check for correct choices
@@ -722,9 +722,9 @@
db_1row get_sort_order_to_be_removed {}
set choices [db_list get_choices {}]
foreach old_choice_id $choices {
- if {$old_choice_id != $choice_id} {
- set new_choice_id [as::item_choice::new_revision -choice_id $old_choice_id -mc_id $new_mc_id]
- }
+ if {$old_choice_id != $choice_id} {
+ set new_choice_id [as::item_choice::new_revision -choice_id $old_choice_id -mc_id $new_mc_id]
+ }
}
db_dml move_up_choices {}
}