--- loncom/homework/functionplotresponse.pm 2010/10/04 19:26:39 1.4 +++ loncom/homework/functionplotresponse.pm 2010/11/07 21:10:14 1.29 @@ -1,7 +1,7 @@ # LearningOnline Network with CAPA # option list style responses # -# $Id: functionplotresponse.pm,v 1.4 2010/10/04 19:26:39 www Exp $ +# $Id: functionplotresponse.pm,v 1.29 2010/11/07 21:10:14 www Exp $ # # Copyright Michigan State University Board of Trustees # @@ -33,9 +33,14 @@ use Apache::lonlocal; use Apache::lonnet; BEGIN { - &Apache::lonxml::register('Apache::functionplotresponse',('functionplotresponse','backgroundplot')); + &Apache::lonxml::register('Apache::functionplotresponse',('functionplotresponse','backgroundplot','spline','functionplotrule')); } +# +# There can be a number of applets on a page, each called ggbApplet_$id, +# where $id is the "_"-concatenated part and responseid +# + sub geogebra_startcode { my ($id)=@_; return (<<ENDSTARTCODE); @@ -49,12 +54,18 @@ sub geogebra_endcode { return &Apache::lonhtmlcommon::java_not_enabled()."</applet>\n"; } +# +# This is the internal GeoGebra bytecode which defines the spline functions +# sub geogebra_spline_program { return (<<ENDSPLINEPROGRAM); <param name="ggbBase64" value="UEsDBBQACAAIADhQET0AAAAAAAAAAAAAAAASAAAAZ2VvZ2VicmFfbWFjcm8ueG1s7Z1bb+PGGYavk19BMDfexkvP+QCsEqzOuWi7gIveBG1By7RXrSwJsqyY+fWdGZLS2pQtzdqWSPoDApOSqCH5vSTnmdH7bj79en8zCVbJ4nY8m7ZCHKEwSKaj2eV4et0K75ZXH1X46y8/frpOZtfJxSIOrmaLm3jZCmlEQvP+TTxazILRzeXf4pukFZ7PJ+NpQsJgOZtNtrw1TCbz9Vu/f8Gn5/j0Czk9J/8Kg/FoNu2PJ+YrYXD7dfbHb9N/mG+040UrXC7ukvXefpvO75ZBjFrh5zCIsVnEZklaYdssqFnE4Vmx7d/vluuNV9nW7VW29ee228zs9NY0P1qa8w+W42W2//hu+XW2sGuX8dK+Y7ZMJslNMl0Gy3Ru3pnPxtNlGEzii2Rij+SXH3/4ZI86mF38Nxkt82MuPr+KJ7eJ3d8Pn8znndlktghM86bY1+7vhfsbT+ZfY7NmRHCbTuI0WQSreGI/zd8xzf11dpk8eDeejo0m9gRul8ncNoBNCedJcpkrmh2yWZmbJp2y3xzQaDZbXN4G962QRBwhKpEginGFJA2DtBWyiDPNJOVYEiwFEmHwZ9au+7orxPn4z/yQqKvqWV6sHWVrN6JsLMIIESqJ4EIiJiXP6yYoUoQIoYggFPHXq5u54l9cOML58UtHIkW4FJJQIqhQQrrK8UhizqRCmHPCNCeveMU1pXIsYlIrIYS57jBhiOWV4+ZdLZCWGEtMsGfl7ueL5NZ2BUU54ov/3Jse4X6erZ7cfwhawQmJUPCX4P7fJzRCH4KPAS1eE/v65wDbhXnj5LN9xd2nJ5vNyaPN7/ONY/OZ+8bJx4d7+PnhHrLN21vbfriJbbH9IQzOSpfF1d3UPfPDB2fqdDN90/kynSTB8ut49L+pKYjRfCPMWekCygQqGnKX01s9s/Y4uJ2CphtBUz9BUx9BUz9B092Cpr6Cpo0TdDS7uYmnl8HUsVXnbrFKOvFimdyO46k72fGajtz9uvyQUY/T2r0w6LPMQMkeaxCzb54Ps29wKcOjs3yHpXKP7K5H612ve6b20yUXz5V8n4ewe/C+WdHFnkX/pzne2eJRsTcoWirk6vlCrrLm1gVcfec1e9BebNMPoYgSTrUQiGGppGbYdUQ4wuYtxJhW1IAk4xk1bna0z/m5vWRb3dq/5qpbX3BZAZbm9RfbqWVPtM/foVw7HxaUlWv7Kdeun3JSC6KphS2sDb1m3IoizbTVjCjFmcJcH0K69mPpzr4dmdnXbkD31JCTloectDzkpN8OOU+/0NNz+roDT/c47ZgFN4v9xqGdVfbtz+3s2+0OjEvL41IimZLIAK151FAN41IYl771uJSbxx8VWFCsGKUwLoVxKYxLYVwK41IYl8K4tB6jGxiXwrj09celz1FcpxHjBoO53CCvMIMGwoSF3WLcYCCOasSxZlRJX4Z7rm5NoV8REcwpNhUiihJRwK+gDJurVjCmEOHspfB7MVrDr131hd/tPPME/OZksy/8dnbDb8e22NmPldyZNo2VtgqabgT1hl8PQVM/QdPdgqa+gr5r+HX3awG/Tmsf+M3nBn3ht915n/DbycrcKSNUxw+hOrVDKGanWhQnhCshCOO0QCgpsNIKGzYWVBF1CITqvGxqn5Wn9ll5ap/9/uWn0/OfTqMoetMp/SAWrbBrFtIs/Gb4u6usMTfTz91t6VrrdGHGH2b8YcYfZvxrWTmY8YcZf5jxhxl/mPGvxKAHZvxhxr9+ysGM/5Fn/IkkBBFlBg7M3CpvPWxo0IQ/VgprpZDGHBeRKR4JZMeuTCGLxkrBjD/M+MOMf3MEhRn/asIvzPhXc8b/ORboNgKhpBHAkpJiBCsm1JvPvHabglAykgafBGdMmCuUSV3MH3IipZaYMso5961cqccdXa4Ryq76ItT2XvEJhMr7x30Rqrsbobq2xe5+Pa4706b1uFsFTTeCeiOUh6Cpn6DpbkFTX0HfNUK5+7VAKKe1D0LlP6/6IlSn+z4RqpuVuVtGqK4fQnVrh1AP5w+pLAiKYM0lYhxLs8Uh+Kn7WDc/xwQvOyZ42THBj+OYCGLVCntmoc3i+wwUvVXWuDNSiNxIId0t61rv9lyzYKgAQwUYKsBQUbfKgaECDBVgqABDBRgqKjEgAkMFGCrqpxwYKsBQUUf4BUMFGCrAUAGGCjBUVAJ+wVABhorjgAAYKsBQAYaKQyIUGCpqLSgYKqqJUGCoqKCh4jkQ6DWCn3SEsZAGk5j5iwghxS/+UnClNULmD5av+Ptrryn8pCNmmFMwxZH9585w8T+lYYxR7C5lpIl+KT5dJmt8squ++LS9R3wCn/K+cV986u3Gp55tsbdfb+vOtGm97VZB042g3vjkIWjqJ2i6W9DUV9B3jU/ufi3wyWntg0+5O80Xn7q994lPvazMvTI+9fzwqVdzfOJM5PykhJSEmcG8wgjjg0xA9R4r5+dIFWVHqig7UkUlHKmmDdNW3y5NY/2XWVT7q2xvzqoqc6uqyq2q2t3V2f56fbcf8KyCZxU8q+BZrVvlwLMKnlXwrIJnFTyrlRg0gWcVPKv1Uw48q+BZrSP8gmcVPKvgWQXPKnhWKwG/4FkFz+pxQAA8q+BZBc/qIREKPKu1FhQ8q9VEKPCsgmf1CBQAnlXwrIJnFTyr4FkFz2qd8Qk8q5X0rD5HAv1GABRGkZTI1FpwTKnBpmICClGJBFGMKySp7y9Rz5WtKQCFcYSlFJgyJDjXhNM3Iajkak1QdtWXoLZ3ik8QVN497ktQ/d0E1bct9vfrcN2ZNq3D3SpouhHUm6A8BE39BE13C5r6CvquCcrdrwVBOa19CCr39/sSVK//Pgmqn5W5Xyaovh9B9WtHUKYDkoxLzgmhTFNW/IanzAdIKs0wUTw3ob8xQfUfK+eX+pHl1I8sp35kNVM/ZsW0NrBL09zgdWJAg1W2fxcHUnkcSOdxIIyKPBB2N352BP2B2zMEgyAYBMEgCAbVrXIQDIJgEASDIBgEwaBKjKsgGATBoPopB8EgCAbVEX4hGATBIAgGQTAIgkGVgF8IBkEw6DggAMEgCAZBMOiQCAXBoFoLCsGgaiIUBIMgGHQECoBgEASDIBgEwSAIBkEwqM74BMEgCAYdBQMgGATBIAgGHZKgIBhUa0EhGFRNgoJgUCWDQc+hwKAZBEUiojRVhp8kR5SJN0eoQWMQikS2ZIJaq6U2/+ECobDEWprRACJ2EPBShrq6XjOUXfVlqO3d4hMMlXeQ+zLUYDdDDWyLg/26XHemTetytwqabgT1ZigPQVM/QdPdgqa+gr5rhnL3a8FQTmsfhsozkr4M1R+8T4YaZGUelBlq4MdQg/ox1AMfFGcFQpnhvbPoMia0OkgGYPBYOL9stSpnq1U5W61qkq02K6a9oV2aBoevG7YerrIDcqFrnYeuMSpS17hIXZMidU3doyE7psHQHQvEryF+DfFriF/XrXIQv4b4NcSvIX4N8etKjLwgfg3x6/opB/FriF/XEX4hfg3xa4hfQ/wa4teVgF+IX0P8+jggAPFriF9D/PqQCAXx61oLCvHraiIUxK8hfn0ECoD4NcSvIX4N8WuIX0P8us74BPFriF8fBQMgfg3xa4hfH5KgIH5da0Ehfl1NgoL4NcSvj8MBEL+G+DXErw/KUBC/rrWgEL+uJkNB/LqK8evnUGDYDISikdCaGVxShlaZRipHKJudZEgyrTizCd7XY6hhYxiKRXg98+T7Q2epY73+uiYlu+pLSts7vydIKe8G9yWl4W5SGtoWh/t1rO5Mm9axbhU03QjqTUoegqZ+gqa7BU19BW06KW3ttIdZpz0sd9pDv057WL9OmyIuiMYYcY40UWvnDZN2Qh5hxjkR7BC99vAFjOuetAXjurvUh3HzfwfEl3EHwwYy7pP/Us3ZdTK7Ti4W8S//B1BLBwhgj4YNdwsAAFgqAQBQSwMEFAAIAAgAOFARPQAAAAAAAAAAAAAAAAwAAABnZW9nZWJyYS54bWytVE2P2jAQPXd/heV7gTgEgpSwareXrVB7YLuH3pxkCC5OHNkOH/vrO7YT2EXqrQdw/Gb8/ObL2eO5keQI2gjV5jSazCiBtlSVaOuc9nb3OaWP64esBlVDoTnZKd1wm9N4wqjDe7F++JSZvToRLr3Lq4BTTndcGqDEdBp4ZfYA9gPO+7OQguvLz+IPlNbcDIHkue16vMXqHrGyqTbCjNupv7CTwn4TR1GBJlKVOV0kKB2/XkFbUXKZ0/ksICyn7M6IUOyse6XFm2qtc7+R7xAhxIg3wIwwh2VTH2gGfSlFJXjrgvE60ImQk6jsPqfLhCEliHqPWpNoFthKpXS1vRgLDTn/Bq3w7iWbLJaLmMX4wz88dgkWlqSTZJGweTRny9UqWWIKUS8KYYtJzFJkZctZki5SluChf9v81XDcgrVYSkP4GcyYz1qL6ppwt3k2X5W8QZ0SrX3ine21b4N4gLb24m7DvGkX45e2ljBgEVZpD+WhUOdtyFscqF8unT/i9RT1k5JKE+0CRf31sBZh9T5O6NVr5n1m3mPgcKRXe7Ri3sOvRVi9lxRtkDYEHo1Rj1XhZ2GIA5Dcde+YG8kLwGagpG+F3YwbbJrDLVLn/6NvCpya921zpYz+E2U2veu37AC6BRm6qsXC9qo35Oi6N5TO66igFA1ug2FICHfF+oUCAlpBrWHUHUYupMtbP3TuHZxNRxFOg0GtpcW3A+OxLpZt51Kfugm3OF05/c4bMGTD8Y2xF0oqbtHLPR3T98f9iA1vzPovUEsHCEyILqxEAgAAlQQAAFBLAQIUABQACAAIADhQET1gj4YNdwsAAFgqAQASAAAAAAAAAAAAAAAAAAAAAABnZW9nZWJyYV9tYWNyby54bWxQSwECFAAUAAgACAA4UBE9TIgurEQCAACVBAAADAAAAAAAAAAAAAAAAAC3CwAAZ2VvZ2VicmEueG1sUEsFBgAAAAACAAIAegAAADUOAAAAAA=="/> ENDSPLINEPROGRAM } +# +# The standard set of parameters inside <applet> +# sub geogebra_default_parameters { my ($id)=@_; return(<<ENDDEFAULTPARAMETERS); @@ -82,13 +93,33 @@ sub geogebra_default_parameters { ENDDEFAULTPARAMETERS } +# +# This subroutine is called by LON-CAPA at </problem> +# Each applet on the page will call function ggbOnInit when it is done loading +# This function in turn will call the respective function registered by start_init_script +# Which one of the registered functions is called is determined by ggbOnInitParam, which GeoGebra passes to ggbOnInit +# + sub init_script { - if ($Apache::functionplotresponse::callscripts) { + if ($#Apache::functionplotresponse::callscripts>=0) { + my $script=''; + foreach my $id (@Apache::functionplotresponse::callscripts) { + $script.="if (param=='applet_$id') { loaded_$id=true; }\n"; + } + $script.="if (".join(' && ',map { "loaded_$_" } (@Apache::functionplotresponse::callscripts)). + ") { setTimeout('ggbInitAll()',20) }"; + my $calls=join("\n",map { "ggbInit_$_();" } (@Apache::functionplotresponse::callscripts)); return (<<ENDGGBINIT); <script type="text/javascript"> // <![CDATA[ +// Function that each applet will call when loaded +// It will pass "its" parameter +// Set flags for when an applet is loaded, wait till all are loaded, and then some function ggbOnInit(param) { -$Apache::functionplotresponse::callscripts +$script +} +function ggbInitAll() { +$calls } // ]]> </script> @@ -96,16 +127,105 @@ ENDGGBINIT } } +# +# Each Geogebra applet is supposed to call this when parameters change +# Changes the hidden fields on the web page +# +sub update_script { + my ($id)=@_; + return (<<ENDUPDATESCRIPT); +<script type="text/javascript"> +// <![CDATA[ +function updatePointCoordinates_$id(coordinateName) { + var x = document.ggbApplet_$id.getXcoord(coordinateName); + var y = document.ggbApplet_$id.getYcoord(coordinateName); + document.lonhomework.elements["HWVAL_$id\_" + coordinateName + "_x"].value = x; + document.lonhomework.elements["HWVAL_$id\_" + coordinateName + "_y"].value = y; + } +// ]]> +</script> +ENDUPDATESCRIPT +} + +# +# Register the above update-handler for a variable +# + +sub update_register { + my ($id,$variable)=@_; + return "document.ggbApplet_$id.registerObjectUpdateListener('$variable','updatePointCoordinates_$id');\n"; +} + +# +# Set a coordinate variable +# +sub set_coordinate { + my ($id,$variable,$x,$y)=@_; + return (<<ENDSETVARIABLE); +document.ggbApplet_$id.evalCommand("$variable=($x,$y)"); +ENDSETVARIABLE +} + +# +# Input field name for a coordinate variable +# + +sub field_name { + my ($id,$variable,$name)=@_; + return "HWVAL_$id\_$variable\_$name"; +} + +# +# Generate an input field for a coordinate variable +# + +sub generate_input_field { + my ($id,$variable,$x,$y)=@_; + $Apache::functionplotresponse::inputfields.= + "<input type='hidden' name='".&field_name($id,$variable,'x')."' value='$x' />\n". + "<input type='hidden' name='".&field_name($id,$variable,'y')."' value='$y' />\n"; +} + +# +# Initialize a new coordinate variable at set a listener on it +# +sub new_coordinate { + my ($id,$variable,$x,$y)=@_; + if (defined($Apache::functionplotresponse::previous{&field_name($id,$variable,'x')})) { + $x=$Apache::functionplotresponse::previous{&field_name($id,$variable,'x')}; + } + if (defined($Apache::functionplotresponse::previous{&field_name($id,$variable,'y')})) { + $y=$Apache::functionplotresponse::previous{&field_name($id,$variable,'y')}; + } + &generate_input_field($id,$variable,$x,$y); + return &set_coordinate($id,$variable,$x,$y).&update_register($id,$variable); +} + +# +# This registers the init-function call for ggbOnInit, which LON-CAPA will place at </problem> +# It then starts the right headers +# sub start_init_script { my ($id)=@_; - $Apache::functionplotresponse::callscripts.="if (param=='applet_$id') { ggbInit_$id(); }\n"; +# Add id to the list of ggbInit_$id functions that need to be called + push(@Apache::functionplotresponse::callscripts,$id); +# ... and open this function return (<<ENDSTARTINIT); <script type="text/javascript"> // <![CDATA[ +// variable that will eventually be passed back to the server +var coordinateMap_$id = []; +// flag for not loaded yet +var loaded_$id=false; +// Init-function for applet function ggbInit_$id() { ENDSTARTINIT } +# +# This sets the axes inside ggbInit_$id +# + sub axes_script { my ($id,$xmin,$xmax,$ymin,$ymax,$xvisible,$yvisible,$gvisible)=@_; return (<<ENDAXESSCRIPT); @@ -119,26 +239,276 @@ sub axes_script { ENDAXESSCRIPT } +sub axes_label { + my ($id,$xlabel,$ylabel)=@_; + unless ($xlabel || $ylabel) { return ''; } + my $return='document.ggbApplet_'.$id.'.evalCommand("topRight=Corner[3]");'; + if ($xlabel) { + $return.=(<<ENDXAXISLABELSCRIPT); +document.ggbApplet_$id.evalCommand("Xlabel=(x(topRight)-AxisStepX[],AxisStepY[]/6)"); +document.ggbApplet_$id.setVisible("Xlabel",false); +document.ggbApplet_$id.evalCommand("Text[\\"$xlabel\\", Xlabel]"); +ENDXAXISLABELSCRIPT + } + if ($ylabel) { + $return.=(<<ENDYAXISLABELSCRIPT); +document.ggbApplet_$id.evalCommand("Ylabel=(AxisStepX[]/6,y(topRight)-AxisStepY[]/3)"); +document.ggbApplet_$id.setVisible("Ylabel",false); +document.ggbApplet_$id.evalCommand("Text[\\"$ylabel\\", Ylabel]"); +ENDYAXISLABELSCRIPT + } + return $return; +} + sub plot_script { - my ($id,$function)=@_; - return (<<ENDPLOTSCRIPT); - document.ggbApplet_$id.evalCommand("y=$function"); + my ($id,$function,$fixed)=@_; + if ($fixed) { +# Use stupid trick to nail this to a location +# Oddly, it seems like only one plot cannot be nailed to a location +# Non-nailed-down plots apparently get overwritten + return (<<ENDPLOTSCRIPT); + document.ggbApplet_$id.evalCommand("a=1"); + document.ggbApplet_$id.setVisible("a",false); + // This MUST be a DEPENDENT OBJECT in order to be locked down: + document.ggbApplet_$id.evalCommand("y=a*($function)"); ENDPLOTSCRIPT + } else { + return "document.ggbApplet_$id.evalCommand('y=$function')"; + } } +# +# Subroutine that generates code for spline $label based on stored information +# + +sub generate_spline { + my ($id,$label)=@_; + my $result=''; + my $order=$Apache::functionplotresponse::splineorder{$label}; + my $x=$Apache::functionplotresponse::splineinitx{$label}; + my $y=$Apache::functionplotresponse::splineinity{$label}; + my $sx=$Apache::functionplotresponse::splinescalex{$label}; + my $sy=$Apache::functionplotresponse::splinescaley{$label}; + my @coords=(); + foreach my $i (1..$order) { + $result.=&new_coordinate($id,$label.'P'.$i,$x,$y); + $x+=$sx/(2.*($order-1)); + push(@coords,$label.'P'.$i); + $result.=&new_coordinate($id,$label.'S'.$i,$x,$y+$sy); + $x+=$sx/(2.*($order-1)); + push(@coords,$label.'S'.$i); + } + $result.='document.ggbApplet_'.$id.'.evalCommand("Spline'.$order.'['.join(',',@coords).']");'."\n"; + return $result; +} +# +# <backgroundplot function="..." fixed="yes/no" /> +# sub start_backgroundplot { my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; my $result=''; my $internalid = $Apache::inputtags::part.'_'.$Apache::inputtags::response[-1]; my $function=&Apache::lonxml::get_param('function',$parstack,$safeeval); + my $fixed=(&Apache::lonxml::get_param('fixed',$parstack,$safeeval)=~/on|true|yes|1/i?1:0); + unless ($function) { $function="0"; } if ($target eq 'web') { - $result.=&plot_script($internalid,$function); + $result.=&plot_script($internalid,$function,$fixed); + } elsif ($target eq 'edit') { + $result=&Apache::edit::tag_start($target,$token,'Background Function Plot'). + &Apache::edit::text_arg('Function:','function', + $token,'16'). + &Apache::edit::select_arg('Fixed location:','fixed', + ['yes','no'],$token). + &Apache::edit::end_row(); + } elsif ($target eq 'modified') { + my $constructtag=&Apache::edit::get_new_args($token,$parstack, + $safeeval,'function','fixed'); + if ($constructtag) { $result=&Apache::edit::rebuild_tag($token); } + } + return $result; +} + +sub end_backgroundplot { + my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; + my $result=''; + if ($target eq 'edit') { + $result=&Apache::edit::end_table(); } return $result; } -sub end_backgroundplot { +# +# <functionplotrule ... /> +# +sub start_functionplotrule { + my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; + my $result=''; + my $label=&Apache::lonxml::get_param('index',$parstack,$safeeval); + $Apache::functionplotresponse::counter++; + if ($label=~/\W/) { + &Apache::lonxml::warning(&mt('Rule indices should only contain alphanumeric characters.')); + } + $label=~s/\W//gs; + unless ($label) { + $label='R'.$Apache::functionplotresponse::counter; + } else { + $label='R'.$label; + } + if ($Apache::functionplotresponse::splineorder{$label}) { + &Apache::lonxml::error(&mt('Rule indices must be unique.')); + } + + + if ($target eq 'grade') { +# Simply remember - in order - for later + my $beginninglabel=&Apache::lonxml::get_param('xinitiallabel',$parstack,$safeeval); + my $endinglabel=&Apache::lonxml::get_param('xfinallabel',$parstack,$safeeval); + if (($beginninglabel=~/\W/) || ($endinglabel=~/W/)) { + &Apache::lonxml::warning(&mt('Rule labels must be alphanumeric.')); + } + $beginninglabel=~s/\W//gs; + $endinglabel=~s/\W//gs; + my $relationship=&Apache::lonxml::get_param('relationship',$parstack,$safeeval); + $relationship=~s/\W//gs; + $relationship=lc($relationship); + unless ($relationship=~/^(eq|ge|gt|le|lt|ne)$/) { + &Apache::lonxml::warning(&mt('Rule relationship not defined.')); + $relationship='eq'; + } + my $derivative=&Apache::lonxml::get_param('derivative',$parstack,$safeeval); + unless (($derivative==0) || ($derivative==1) || ($derivative==2)) { + &Apache::lonxml::warning(&mt('Rule derivative not defined.')); + $derivative=0; + } + push(@Apache::functionplotresponse::functionplotrules,join(':',( + $label, + $derivative, + &Apache::lonxml::get_param('xinitial',$parstack,$safeeval), + $beginninglabel, + &Apache::lonxml::get_param('xfinal',$parstack,$safeeval), + $endinglabel, + $relationship, + &Apache::lonxml::get_param('value',$parstack,$safeeval) + ))); + } elsif ($target eq 'edit') { + $result=&Apache::edit::tag_start($target,$token,'Function Plot Evaluation Rule'). + &Apache::edit::text_arg('Index:','index', + $token,'4').' '. + &Apache::edit::select_arg(&mt('Function:'),'derivative', + [['0','Function itself'], + ['1','First derivative'], + ['2','Second derivative']],$token). + &Apache::edit::text_arg('(Initial) x-value:','xinitial', + $token,'4').' '. + &Apache::edit::text_arg('Final x-value for ranges:','xfinal', + $token,'4').' '. + &Apache::edit::select_arg(&mt('Relationship:'),'relationship', + [['eq','equal'], + ['ne','not equal'], + ['ge','greater than or equal'], + ['gt','greater than'], + ['lt','less than'], + ['le','less than or equal']],$token). + $result.= &Apache::edit::select_or_text_arg('Value:','value', + [['undef','not defined']],$token,'4'). + &Apache::edit::text_arg('Percent error:','percenterror', + $token,'4'). + &Apache::edit::end_row(); + } elsif ($target eq 'modified') { + my $constructtag=&Apache::edit::get_new_args($token,$parstack, + $safeeval,'index','derivative','xinitial','xfinal','relationship', + 'value','percenterror'); + if ($constructtag) { $result=&Apache::edit::rebuild_tag($token); } + } + return $result; +} + +sub end_functionplotrule { + my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; + my $result=''; + if ($target eq 'edit') { + $result=&Apache::edit::end_table(); + } + return $result; +} + + +# +# <spline index="..." order="1,2,3,4" initx="..." inity="..." scalex="..." scaley="..." /> +# +# Unfortunately, GeoGebra seems to want all splines after everything else, so we need to store them +# +sub start_spline { + my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; + my $result=''; + if ($target eq 'web') { + my $label=&Apache::lonxml::get_param('index',$parstack,$safeeval); + $Apache::functionplotresponse::counter++; + if ($label=~/\W/) { + &Apache::lonxml::warning(&mt('Spline indices should only contain alphanumeric characters.')); + } + $label=~s/\W//gs; + unless ($label) { + $label='S'.$Apache::functionplotresponse::counter; + } else { + $label='S'.$label; + } + if ($Apache::functionplotresponse::splineorder{$label}) { + &Apache::lonxml::error(&mt('Spline indices must be unique.')); + } + + my $order=&Apache::lonxml::get_param('order',$parstack,$safeeval); + if ($order<2) { $order=2; } + if ($order>8) { $order=8; } + $Apache::functionplotresponse::splineorder{$label}=$order; + + my $x=&Apache::lonxml::get_param('initx',$parstack,$safeeval); + unless ($x) { $x=0; } + $Apache::functionplotresponse::splineinitx{$label}=$x; + + my $y=&Apache::lonxml::get_param('inity',$parstack,$safeeval); + unless ($y) { $y=0; } + $Apache::functionplotresponse::splineinity{$label}=$y; + + my $sx=&Apache::lonxml::get_param('scalex',$parstack,$safeeval); + unless ($sx) { $sx=$order; } + $Apache::functionplotresponse::splinescalex{$label}=$sx; + + my $sy=&Apache::lonxml::get_param('scaley',$parstack,$safeeval); + unless ($sy) { $sy=2; } + $Apache::functionplotresponse::splinescaley{$label}=$sy; + } elsif ($target eq 'edit') { + $result=&Apache::edit::tag_start($target,$token,'Spline'). + &Apache::edit::text_arg('Index:','index', + $token,'4').' '. + &Apache::edit::select_arg('Order:','order', + ['2','3','4','5','6','7','8','9'],$token).' '. + &Apache::edit::text_arg('Initial x-value:','initx', + $token,'4').' '. + &Apache::edit::text_arg('Initial y-value:','inity', + $token,'4').' '. + &Apache::edit::text_arg('Scale x:','scalex', + $token,'4').' '. + &Apache::edit::text_arg('Scale y:','scaley', + $token,'4'). + &Apache::edit::end_row(); + } elsif ($target eq 'modified') { + my $constructtag=&Apache::edit::get_new_args($token,$parstack, + $safeeval,'index','order','initx','inity', + 'scalex','scaley'); + if ($constructtag) { $result=&Apache::edit::rebuild_tag($token); } + } + return $result; +} + +sub end_spline { + my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; + my $result=''; + if ($target eq 'edit') { + $result=&Apache::edit::end_table(); + } + return $result; } sub end_init_script { @@ -149,43 +519,405 @@ sub end_init_script { ENDENDINIT } +# +# Storing and restoring spline coordinates from part answers +# +sub decode_previous_answer { + my ($answer)=@_; + foreach my $coordinate (split(/\,/,$answer)) { + my ($key,$value)=split(/\=/,$coordinate); + $Apache::functionplotresponse::previous{$key}=$value; + } +} + +sub get_answer_from_form_fields { + my ($id)=@_; + my $answer=''; + my %coords=(); + foreach my $field (keys(%env)) { + if ($field=~/^form\.HWVAL\_$id/) { + $field=~/^form\.(.*)$/; + $coords{$1}=$env{$field}; + } + } + $answer=join(',',map { $_.'='.$coords{$_} } (sort(keys(%coords)))); + return ($answer,%coords); +} + +# +# The following functions calculate the cubic-hermite splines server-side +# + +sub cubic_hermite { + my ($t,$p1,$s1,$p2,$s2)=@_; + return (2.*$t*$t*$t-3.*$t*$t+1.)*$p1 + 5.*($t*$t*$t-2.*$t*$t+$t)*($s1-$p1)+ + (-2.*$t*$t*$t+3.*$t*$t) *$p2 + 5.*($t*$t*$t-$t*$t) *($s2-$p2); +} + +# +# d/dt(...) +# + +sub ddt_cubic_hermite { + my ($t,$p1,$s1,$p2,$s2)=@_; + return (6.*$t*$t-6.*$t) *$p1 + 5.*(3.*$t*$t-4.*$t+1.)*($s1-$p1)+ + (-6.*$t*$t+6.*$t)*$p2 + 5.*(3.*$t*$t-2.*$t) *($s2-$p2); +} + +# +# d^2/dt^2(...) +# + +sub d2dt2_cubic_hermite { + my ($t,$p1,$s1,$p2,$s2)=@_; + return (12.*$t-6.) *$p1 + 5.*(6.*$t-4.)*($s1-$p1)+ + (-12.*$t+6.)*$p2 + 5.*(6.*$t-2.)*($s2-$p2); +} + +# +# Array index calculation +# +sub array_index { + my ($xmin,$xmax,$x)=@_; + return int(($x-$xmin)/($xmax-$xmin)*400.+0.5); +} + +# +# Populate the arrays +# + +sub populate_arrays { + my ($id,$xmin,$xmax)=@_; + for (my $i=0; $i<=400; $i++) { + $Apache::functionplotresponse::func[$i]=undef; + $Apache::functionplotresponse::dfuncdx[$i]=undef; + $Apache::functionplotresponse::d2funcd2x[$i]=undef; + } + unless ($xmax>$xmin) { return 'no_func'; } +# Run over all splines in response + foreach my $label (split(/\,/,$env{"form.HWVAL_AllSplines_$id"})) { + my $xiold=-1; +# Run over all points in spline + for (my $i=1; $i<$env{"form.HWVAL_SplineOrder_".$id."_".$label}; $i++) { + my $ni=$i+1; + my @xparms=($env{'form.HWVAL_'.$id.'_'.$label.'P'.$i.'_x'}, + $env{'form.HWVAL_'.$id.'_'.$label.'S'.$i.'_x'}, + $env{'form.HWVAL_'.$id.'_'.$label.'P'.$ni.'_x'}, + $env{'form.HWVAL_'.$id.'_'.$label.'S'.$ni.'_x'}); + my @yparms=($env{'form.HWVAL_'.$id.'_'.$label.'P'.$i.'_y'}, + $env{'form.HWVAL_'.$id.'_'.$label.'S'.$i.'_y'}, + $env{'form.HWVAL_'.$id.'_'.$label.'P'.$ni.'_y'}, + $env{'form.HWVAL_'.$id.'_'.$label.'S'.$ni.'_y'}); +# Run in small steps over spline parameter + for (my $t=0; $t<=1; $t+=0.0001) { + my $xi=&array_index($xmin,$xmax,&cubic_hermite($t,@xparms)); + if ($xi<$xiold) { return 'no_func'; } + if (($xi>$xiold) && ($xi>=0) && ($xi<=400)) { + if (defined($Apache::functionplotresponse::func[$xi])) { return 'no_func'; } + $xiold=$xi; +# Function value + $Apache::functionplotresponse::func[$xi]=&cubic_hermite($t,@yparms); +# Chain rule +# dy/dx=dy/dt/(dx/dt) + my $dxdt=&ddt_cubic_hermite($t,@xparms); + if ($dxdt) { + $Apache::functionplotresponse::dfuncdx[$xi]=&ddt_cubic_hermite($t,@yparms)/$dxdt; + } +# Faa di Bruno +# d^2y/dx^2=(d^2y/dt^2)/(dx/dt)^2+(dy/dt)/(d^2x/dt^2) + my $d2xdt2=&d2dt2_cubic_hermite($t,@xparms); + if (($dxdt) && ($d2xdt2)) { + $Apache::functionplotresponse::d2funcdx2[$xi]= + &d2dt2_cubic_hermite($t,@yparms)/($dxdt*$dxdt) + +&ddt_cubic_hermite($t,@yparms)/$d2xdt2; + } + } + } + } + } +} + +# +# Implentation of <functionplotresponse> +# + sub start_functionplotresponse { my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; my $result=''; - my $internalid = $Apache::inputtags::part.'_'.&Apache::response::start_response($parstack,$safeeval); +# To remember the splines - somehow, they need to come last + undef %Apache::functionplotresponse::splineorder; + undef %Apache::functionplotresponse::splineinitx; + undef %Apache::functionplotresponse::splineinity; + undef %Apache::functionplotresponse::splinescalex; + undef %Apache::functionplotresponse::splinescaley; +# Remember input fields, etc + undef %Apache::functionplotresponse::previous; + $Apache::functionplotresponse::inputfields=''; + $Apache::functionplotresponse::counter=0; +# Remember rules + undef @Apache::functionplotresponse::functionplotrules; +# Part and ID + my $partid=$Apache::inputtags::part; + my $id=&Apache::response::start_response($parstack,$safeeval); +# Internal ID to mark the applet and its coordinates + my $internalid = $partid.'_'.$id; +# Previous answer + &decode_previous_answer($Apache::lonhomework::history{"resource.$partid.$id.submission"}); + +# Parameters of <functionplotresponse> my $xmin=&Apache::lonxml::get_param('xmin',$parstack,$safeeval); - $xmin=($xmin?$xmin:-10); + $xmin=(defined($xmin)?$xmin:-10); my $xmax=&Apache::lonxml::get_param('xmax',$parstack,$safeeval); - $xmax=($xmax?$xmax:10); + $xmax=(defined($xmax)?$xmax:10); my $ymin=&Apache::lonxml::get_param('ymin',$parstack,$safeeval); - $ymin=($ymin?$ymin:-10); + $ymin=(defined($ymin)?$ymin:-10); my $ymax=&Apache::lonxml::get_param('ymax',$parstack,$safeeval); - $ymax=($ymax?$ymax:10); - my $xaxisvisible=(&Apache::lonxml::get_param('xaxisvisible',$parstack,$safeeval)=~/on|true|1/i?'true':'false'); - my $yaxisvisible=(&Apache::lonxml::get_param('yaxisvisible',$parstack,$safeeval)=~/on|true|1/i?'true':'false'); - my $gridvisible=(&Apache::lonxml::get_param('gridvisible',$parstack,$safeeval)=~/on|true|1/i?'true':'false'); - - - if ($target eq 'web') { + $ymax=(defined($ymax)?$ymax:10); + if ($xmax<=$xmin) { + &Apache::lonxml::warning('Maximum x-value needs to be larger than minimum value.'); + $xmax=$xmin+20; + } + if ($ymax<=$ymin) { + &Apache::lonxml::warning('Maximum y-value needs to be larger than minimum value.'); + $ymax=$ymin+20; + } + my $xaxisvisible=(&Apache::lonxml::get_param('xaxisvisible',$parstack,$safeeval)=~/on|true|yes|1/i?'true':'false'); + my $yaxisvisible=(&Apache::lonxml::get_param('yaxisvisible',$parstack,$safeeval)=~/on|true|yes|1/i?'true':'false'); + my $gridvisible=(&Apache::lonxml::get_param('gridvisible',$parstack,$safeeval)=~/on|true|yes|1/i?'true':'false'); + my $xlabel=&Apache::lonxml::get_param('xlabel',$parstack,$safeeval); + my $ylabel=&Apache::lonxml::get_param('ylabel',$parstack,$safeeval); + if ($target eq 'edit') { + $result.=&Apache::edit::start_table($token) + .'<tr><td><span class="LC_nobreak">'.&mt('Function Plot Question').'</span></td>' + .'<td><span class="LC_nobreak">'.&mt('Delete?').' ' + .&Apache::edit::deletelist($target,$token) + .'</span></td>' + ."<td> " + .&Apache::edit::end_row() + .&Apache::edit::start_spanning_row() + ."\n"; + $result.=&Apache::edit::text_arg('Label x-axis:','xlabel', + $token,'6').' '. + &Apache::edit::text_arg('Minimum x-value:','xmin', + $token,'4').' '. + &Apache::edit::text_arg('Maximum x-value:','xmax', + $token,'4').' '. + &Apache::edit::select_arg('x-axis visible:','xaxisvisible', + ['yes','no'],$token).' '. + &Apache::edit::text_arg('Label y-axis:','ylabel', + $token,'6').' '. + &Apache::edit::text_arg('Minimum y-value:','ymin', + $token,'4').' '. + &Apache::edit::text_arg('Maximum y-value:','ymax', + $token,'4').' '. + &Apache::edit::select_arg('y-axis visible:','yaxisvisible', + ['yes','no'],$token).' '. + &Apache::edit::select_arg('Grid visible:','gridvisible', + ['yes','no'],$token). + &Apache::edit::end_row().&Apache::edit::start_spanning_row(); + } elsif ($target eq 'modified') { + my $constructtag=&Apache::edit::get_new_args($token,$parstack, + $safeeval,'xlabel','xmin','xmax','ylabel','ymin','ymax', + 'xaxisvisible','yaxisvisible','gridvisible'); + if ($constructtag) { $result = &Apache::edit::rebuild_tag($token); } + + } elsif ($target eq 'meta') { + $result=&Apache::response::meta_package_write('functionplotresponse'); + } elsif ($target eq 'web') { +# paste in the update routine to receive stuff back from the applet + $result.=&update_script($internalid); +# start the initscript for this applet $result.=&start_init_script($internalid); +# put the axis commands inside $result.=&axes_script($internalid,$xmin,$xmax,$ymin,$ymax,$xaxisvisible,$yaxisvisible,$gridvisible); + $result.=&axes_label($internalid,$xlabel,$ylabel); +# init script is left open } return $result; } +sub compare_rel { + my ($relationship,$value,$realval,$tol)=@_; + + + &Apache::lonnet::logthis("Rel $relationship Val $value RV $realval T $tol"); +# is the real value defined? + unless (defined($realval)) { + if ($relationship eq 'eq') { + if ($value eq 'undef') { + return 1; + } else { + return 0; + } + } elsif ($relationship eq 'ne') { + if ($value eq 'undef') { + return 0; + } else { + return 1; + } + } else { + return 0; + } + } + +# it is defined. + if ($relationship eq 'gt') { + return ($realval>$value); + } elsif ($relationship eq 'ge') { + return ($realval>$value-$tol); + } elsif ($relationship eq 'lt') { + return ($realval<$value); + } elsif ($relationship eq 'le') { + return ($realval<$value+$tol); + } elsif ($relationship eq 'ne') { + return (abs($value-$realval)>$tol); + } else { + return (abs($value-$realval)<$tol); + } + return 0; +} + +sub functionplotrulecheck { + my ($rule,$xmin,$xmax,$tolfunc,$toldfdx,$told2fdx2)=@_; + &Apache::lonnet::logthis("Rule $rule TolFunc $tolfunc TolDfDx $toldfdx TolD2fDx2 $told2fdx2"); + my ($label,$derivative,$xinitial,$xinitiallabel,$xfinal,$xfinallabel,$relationship,$value) + =split(/\:/,$rule); +# if a hard value is set for the boundaries, it overrides the label + if (($xinitial ne '') && ($xinitiallabel ne '')) { + $Apache::functionplotresponse::functionplotrulelabels{$xinitiallabel}=$xinitial; + } + if (($xfinal ne '') && ($xfinallabel ne '')) { + $Apache::functionplotresponse::functionplotrulelabels{$xfinallabel}=$xfinal; + } + if (defined($Apache::functionplotresponse::functionplotrulelabels{$xinitiallabel})) { + $xinitial=$Apache::functionplotresponse::functionplotrulelabels{$xinitiallabel}; + } + if (defined($Apache::functionplotresponse::functionplotrulelabels{$xfinallabel})) { + $xfinal=$Apache::functionplotresponse::functionplotrulelabels{$xfinallabel}; + } +# Basic sanity checks + if ($xinitial eq '') { + $xinitial=0; + } + if ($xfinal eq '') { + $xfinal=$xinitial; + } + if ($xinitial>$xfinal) { + $xfinal=$xinitial; + } + &Apache::lonnet::logthis("Init $xinitial Final $xfinal"); + my $tol=$tolfunc; + if ($derivative==2) { + $tol=$told2fdx2; + } elsif ($derivative==1) { + $tol=$toldfdx; + } + + my $li=&array_index($xmin,$xmax,$xinitial); + my $lh=&array_index($xmin,$xmax,$xfinal); + for (my $i=$li; $i<=$lh; $i++) { + my $val; + if ($derivative==2) { + $val=$Apache::functionplotresponse::d2funcdx2[$i]; + } elsif ($derivative==1) { + $val=$Apache::functionplotresponse::dfuncdx[$i]; + } else { + $val=$Apache::functionplotresponse::func[$i]; + } + unless (&compare_rel($relationship,$value,$val,$tol)) { return 0; }; + } + return 1; +} + sub end_functionplotresponse { my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; &Apache::response::end_response; my $result; - my $internalid = $Apache::inputtags::part.'_'.$Apache::inputtags::response[-1]; + my $id=$Apache::inputtags::response[-1]; + my $partid=$Apache::inputtags::part; + my $internalid = $partid.'_'.$id; + + if ($target eq 'edit') { $result=&Apache::edit::end_table(); } + if ($target eq 'grade' + && &Apache::response::submitted() + && $Apache::lonhomework::type eq 'exam') { + + &Apache::response::scored_response($partid,$id); + + } elsif ($target eq 'grade' + && &Apache::response::submitted() + && $Apache::lonhomework::type ne 'exam') { + my ($response,%coords)=&get_answer_from_form_fields($internalid); + $Apache::lonhomework::results{"resource.$partid.$id.submission"}=$response; + my %previous=&Apache::response::check_for_previous($response,$partid,$id); +# +# Actually grade +# + my $xmin=&Apache::lonxml::get_param('xmin',$parstack,$safeeval); + $xmin=(defined($xmin)?$xmin:-10); + my $xmax=&Apache::lonxml::get_param('xmax',$parstack,$safeeval); + $xmax=(defined($xmax)?$xmax:10); + my $ymin=&Apache::lonxml::get_param('ymin',$parstack,$safeeval); + $ymin=(defined($ymin)?$ymin:-10); + my $ymax=&Apache::lonxml::get_param('ymax',$parstack,$safeeval); + $ymax=(defined($ymax)?$ymax:10); + + my $percent=&Apache::lonxml::get_param('percenterror',$parstack,$safeeval); + $percent=(defined($percent)?$percent:5); + + my $tolfunc=$percent*($ymax-$ymin)/100.; + my $toldfdx=1; + my $told2fdx2=1; + if ($xmax>$xmin) { + $toldfdx=$tolfunc/($xmax-$xmin); + $told2fdx2=$toldfdx/($xmax-$xmin); + } + + my $ad=''; + if (&populate_arrays($internalid,$xmin,$xmax) eq 'no_func') { + $ad='NOT_FUNCTION'; + } else { +# We have a function that we can actually grade, go through the spline rules. + undef %Apache::functionplotresponse::functionplotrulelabels; + foreach my $rule (@Apache::functionplotresponse::functionplotrules) { + unless (&functionplotrulecheck($rule,$xmin,$xmax,$tolfunc,$toldfdx,$told2fdx2)) { + $ad='INCORRECT'; + last; + } + } +# If it's not wrong, it's correct + unless ($ad) { $ad='EXACT_ANS' }; + } -# if ($target eq 'edit') { $result=&Apache::edit::end_table(); } - if ($target eq 'web') { +# +# Store grading info +# + $Apache::lonhomework::results{"resource.$partid.$id.awarddetail"}=$ad; + &Apache::response::handle_previous(\%previous,$ad); + } elsif ($target eq 'web') { +# Now is the time to render all of the stored splines + foreach my $label (keys(%Apache::functionplotresponse::splineorder)) { + $result.=&generate_spline($internalid,$label); + } +# close the init script $result.=&end_init_script(); +# register all splines in this response + $result.='<input type="hidden" name="HWVAL_AllSplines_'.$internalid.'" value="'. + join(',',keys(%Apache::functionplotresponse::splineorder)).'" />'."\n"; + foreach my $label (keys(%Apache::functionplotresponse::splineorder)) { + $result.='<input type="hidden" name="HWVAL_SplineOrder_'.$internalid.'_'.$label.'" value="'. + $Apache::functionplotresponse::splineorder{$label}.'" />'."\n"; + } +# generate the input fields + $result.=$Apache::functionplotresponse::inputfields; +# actually start the <applet>-tag $result.=&geogebra_startcode($internalid); +# load the spline bytecode $result.=&geogebra_spline_program(); +# set default parameters $result.=&geogebra_default_parameters($internalid); +# close the <applet>-tag $result.=&geogebra_endcode(); } return $result;