Beefy Boxes and Bandwidth Generously Provided by pair Networks
go ahead... be a heretic

automateaching -- part 2: proof of concept

by Discipulus (Abbot)
on Sep 30, 2020 at 08:45 UTC ( #11122359=perlmeditation: print w/replies, xml ) Need Help??

Only Perl can teach Perl


This is the follow up of Perl Automateaching -- part 1: brainstorming so read it first to have an idea of my intentions even if the pseudocode presented there is not what I currently plan.

I have choosen the name for this project and it will be Perl::Teacher as it is clear and explicative.

This post is a mere proof of concept about Perl teaching and, yes! it can be done! I'd like to be billionaire to hire super skilled perl geeks to develop my idea... but let's say they are all busy at the moment :) so the pupil (discipulus in Latin) will squeeze his brain and will dress teacher dresses. Contributors are welcome!

In the final form Perl::Teacher will be document oriented, ie: it will analyze perl programs wrote by the pupil in physical files. But in the current proof of concepts various student's attempts are hardcoded into the below program contained in scalars from $work_01 to $work_n and with a $solution_code

Also the final form of Perl::Teacher will be a bit interactive presenting and reviewing assignements and telling small lessons, but for the moment nothing of this is done.

So running the below program you will see a serie of attempts to satisfy the assignemnt and results of tests applied to provided code fragments.

Modify the $debug variable to 1 or 2 to see much more messages.

Proof of concept

Here my efforts up now (Ignore the warning you'll receive: Having more than one /x regexp modifier is deprecated at .../perl5.24-64b/perl/site/lib/Perl/Critic/Policy/ValuesAndExpressions/ line 110. beacuse it is a problem of Perl::Critic itself: see resolved issue on github)

use strict; use warnings; use PPI; use PPI::Dumper; use Perl::Critic; use Test::Deep::NoTest; use Data::Dump; my $debug = 0; # 0..2 my $perl_critic_severity = 'gentle'; # 'gentle' 'stern' 'harsh' 'crue +l' 'brutal' # assignemnt print <<'EOP'; Assignement: -Create an array named @letters with 5 elements and fill it with first + 5 letters of the English alphabet -Remove the first element using a list operator and assign it to a sca +lar variable -Remove the last element using a list operator and assign it to a scal +ar variable -Join these two removed elements with a '-' (using single quotes) sign + and assign the result to a scalar named $result NB: All variables have to be lexically scoped NB: each above steps must be accomplished in one statement EOP # solution code my $solution_code = <<'EOC'; use strict; use warnings; my @letters = ('a'..'e'); my $first = shift @letters; my $last = pop @letters; my $result = join '-', $first, $last; EOC # student attempts my $work_01 = <<EOT; need to crash! EOT my $work_02 = <<EOT; # comment: no need to crash! EOT my $work_03 = <<EOT; # comment: no need to crash! use strict; EOT my $work_04 = <<EOT; # comment: no need to crash! use strict; use warnings; EOT my $work_05 = <<'EOT'; use strict; use warnings; my @letters = ('a'..'e'); EOT my %tests = ( # TEST DESCRIPTION # number => anonymous hash (tests will be executed in a sorted + order) # name => # run => send the code to a sub returning 0|1 plus + messages # select_child_of => given a PPI class search each element + of such class # to see if they contain all required el +ements. # returns 0|1 plus messages # class => the class of elements to analyze (all el +ements of such class will be tested) # tests => anonymous array: check children of the c +urrent element to be of the appropriate class # and to hold the desired content (string +or regex can be used) # evaluate_to => optional but only possible if select_child +_of was used: the DPOM fragment # extracted by select_child_of will be chec +k to hold a precise value (at runtime: see below) # hint => # docs => 001 => { name => 'code compiles', run => \&test_compile, # select_child_of ... # evaluate_to ... hint => "comment the line causing crash with a # in fro +nt of it", docs => ['perldoc perlintro', ' +/perlintro.html#Basic-syntax-overview'], }, 002 => { name => 'strictures', # run => ... select_child_of => { class => 'PPI::Statement::Include', tests => [ #['PPI::Token::Word', 'use'], ['PPI::Token::Word', qr/^use$/], ['PPI::Token::Word', 'strict'] ], }, # evaluate_to ... hint => "search perlintro for safety net", docs => [' +y-net'], }, 003 => { name => 'warnings', # run => ... select_child_of => { class => 'PPI::Statement::Include', tests => [ ['PPI::Token::Word', 'use'], #['PPI::Token::Word', qr/^use$/], ['PPI::Token::Word', 'warnings'] ], }, # evaluate_to ... hint => "search perlintro for safety net", docs => [' +y-net'], }, 004 => { name => 'array creation', select_child_of => { class => 'PPI::Statement::Variable', tests => [ ['PPI::Token::Word', 'my'], ['PPI::Token::Symbol', '@letters'], ['PPI::Token::Operator', '='], ], }, evaluate_to => [ ('a'..'e') ], hint => "search perlintro basic variable types", docs => [' +variable-types'], }, 005 => { name => 'first element of the array', select_child_of => { class => 'PPI::Statement::Variable', tests => [ ['PPI::Token::Word', 'my'], ['PPI::Token::Symbol', qr/\$[\S]/], ['PPI::Token::Operator', '='], ['PPI::Token::Word', 'shift'], ['PPI::Token::Symbol', '@letters'], ], }, evaluate_to => \'a', hint => "search functions related to real arrays", docs => [' +#Perl-Functions-by-Category'], }, 006 => { name => 'last element of the array', select_child_of => { class => 'PPI::Statement::Variable', tests => [ ['PPI::Token::Word', 'my'], ['PPI::Token::Symbol', qr/\$[\S]/], ['PPI::Token::Operator', '='], ['PPI::Token::Word', 'pop'], ['PPI::Token::Symbol', '@letters'], ], }, evaluate_to => \'e', hint => "search functions related to real arrays", docs => [' +#Perl-Functions-by-Category'], }, 007 => { name => 'final result', select_child_of => { class => 'PPI::Statement::Variable', tests => [ ['PPI::Token::Word', 'my'], ['PPI::Token::Symbol', '$result'], ['PPI::Token::Operator', '='], ['PPI::Token::Word', 'join'], ['PPI::Token::Quote::Single', "'-'"], ['PPI::Token::Operator', ','], ['PPI::Token::Symbol', qr/^\$[\S]/], ['PPI::Token::Operator', ','], ['PPI::Token::Symbol', qr/^\$[\S]/], ], }, evaluate_to => \'a-e', hint => "search functions related to strings", docs => [' +#Perl-Functions-by-Category'], }, ); # student's attempts examination foreach my $code ( $work_01, $work_02, $work_03, $work_04, $work_05, $ +solution_code){ $code = PPI::Document->new( \$code ); print "\n# START of provided code:\n",$code=~s/^/| /gmr,"# END of +provided code\n# TESTS:\n"; PPI::Dumper->new($code)->print if $debug > 1; my $passed_tests; foreach my $test (sort keys %tests){ print "DEBUG: starting test $test - $tests{ $test }{ name }\n" + if $debug; # if run defined my $run_result; my $run_msg; if ( exists $tests{ $test }{ run } ){ ($run_result, $run_msg) = $tests{ $test }{ run }->( $code +); if ( $run_result ){ print "OK test [$tests{ $test }{ name }]\n"; $passed_tests++; # next test next; } else{ $run_msg =~ s/\n//; print "FAILED test [$tests{ $test }{ name }] because: +$run_msg\n"; if ( $tests{ $test }{ hint } ){ print "HINT: $tests{ $test }{ hint }\n"; } if ( $tests{ $test }{ docs } ){ print map {"DOCS: $_\n"} @{$tests{ $test }{ docs } +} ; } last; } } # select_child_of defined my $candidate_pdom; my $select_child_of_msg; if ( exists $tests{ $test }{ select_child_of } ){ ($candidate_pdom, $select_child_of_msg) = select_child_of( pdom => $code, wanted_class => $tests{ $test }{ select_child_of } +{ class }, tests => $tests{ $test }{ select_child_of }{ tests + } ); } # also evaluation is required if( $candidate_pdom and exists $tests{ $test }{ evaluate_to } +){ my ($evauleted_pdom, $eval_msg) = evaluate_to ( $candidate_pdom, $tests{ $test }{ evalua +te_to } ); if($evauleted_pdom){ print "OK test [$tests{ $test }{ name }]\n"; $passed_tests++; # jump to next test next; } else{ print "FAILED test [$tests{ $test }{ name }] becau +se: $eval_msg\n"; if ( $tests{ $test }{ hint } ){ print "HINT: $tests{ $test }{ hint }\n"; } if ( $tests{ $test }{ docs } ){ print map {"DOCS: $_\n"} @{$tests{ $test }{ do +cs }} ; } } } elsif( $candidate_pdom ){ print "OK test [$tests{ $test }{ name }]\n"; $passed_tests++ ; # jump to next test next; } else{ print "FAILED test [$tests{ $test }{ name }] because: $sel +ect_child_of_msg\n"; if ( $tests{ $test }{ hint } ){ print "HINT: $tests{ $test }{ hint }\n"; } if ( $tests{ $test }{ docs } ){ print map {"DOCS: $_\n"} @{$tests{ $test }{ docs }} ; } # if one test breaks end the testing loop last; } } # all tests passed if ( $passed_tests == scalar keys %tests ){ print "\nALL tests passed\n"; my $critic = Perl::Critic->new( -severity => $perl_critic_sev +erity ); my @violations = $critic->critique($code); if ( @violations ){ print "Perl::Critic violations (with severity: $perl_criti +c_severity):\n"; print @violations; } else{ print "No Perl::Critic violations using severity level: $p +erl_critic_severity\n"; } } print "\n\n"; } ################################ # TESTS ################################ sub evaluate_to{ my $pdom = shift; # passed by reference my $expected_value = shift; ############################### # VERY DIRTY TRICK - START ############################### # only last element is returned in string evaluation # so the below code cuts the parent where the current # pdom is found. so the current statement will be the # last one of the whole code (parent) and its value # returned by the string evaluation # (probably I'll need to redirect STDOUT in this scope) # # NB this will fail for multiline statements! my $pdom_parent = $pdom->parent; my @lines_od_code = split/\n/,$pdom_parent->content; if ( $debug > 1 ){ print "ORIGINAL CODE:\n"; dd @lines_od_code; print "FOUND current PDOM element at line: ", $pdom->line_numb +er, "\n"; print "CUTTING code at line: ", $pdom->line_number, "\n"; dd @lines_od_code[0..$pdom->line_number-1] } $pdom = PPI::Document->new( \join"\n",@lines_od_code[0..$pdom->lin +e_number-1] ); ############################### # VERY DIRTY TRICK - END ############################### { local $@; my $got; # we expect a scalar ref if ( ref $expected_value eq 'SCALAR' ){ $got = \eval $pdom ; } # we expect an array ref elsif ( ref $expected_value eq 'ARRAY' ){ $got = [ eval $pdom ]; } # we expect a hash ref elsif ( ref $expected_value eq 'HASH' ){ $got = { eval $pdom }; } # we expect a regexp ref elsif ( ref $expected_value eq 'Regexp' ){ $got = eval $pdom; $got = qr/$got/; } # Not a reference else{ $got = eval $pdom; } # check to be the same type if ( ref $expected_value ne ref $got ){ return (0, "got and expected values are not of the same ty +pe") } else{ print "DEBUG: OK both got and expected are of the same typ +e: ", ref $got,"\n" if $debug; } if ( eq_deeply( $got, $expected_value ) ){ if ( $debug > 1 ){ print "DEBUG: OK both got and expected hold sa +me content: "; dd $got; } return ($pdom, "expected value found for the expre +ssion [$pdom]"); } else{ if ( $debug ){ print "GOT: ",ref $got,"\n"; dd $got; print "EXPECTED: ",ref $expected_value,"\n"; dd $expected_value; #print "PARENT: "; PPI::Dumper->new( $pdom->parent )-> +print; } return (0, "wrong value of the expression [$pdom]") } } } sub select_child_of{ my %opt = @_; my $pdom_fragments = $opt{ pdom }->find( $opt{ wanted_class } ); return (0, "no element found of the correct type") unless $pdom_fr +agments; foreach my $pdom_candidate ( @$pdom_fragments ){ print "DEBUG: checking fragment: [$pdom_candidate]\n" if $debu +g; my $expected_ok; foreach my $test ( @{$opt{ tests }} ){ my ($class, $content) = @$test; print "DEBUG: testing for class [$class] and content [$con +tent]\n" if $debug; if ( $pdom_candidate->find( sub { $_[1]->isa($class) and ( ref $content eq 'R +egexp' ? ( $_[1]->content = +~ /$content/ ) : ( $_[1]->content e +q $content ) ) } ) ){ $expected_ok++; #print "DEBUG FOUND: [",ref $_[1],"] [",$_[1]->content +,"]\n"; print "DEBUG: OK..\n" if $debug; if ( $expected_ok == scalar @{$opt{ tests }} ){ print "DEBUG: found a good candidate: [$pdom_candi +date]\n" if $debug; return ( $pdom_candidate, "found expected code in: + [$pdom_candidate]" ) } } else{ print "DEBUG: FAIL skipping to next fragment of co +de\n" if $debug; last; } } } #FAILED return (0,"element not found") } sub test_compile{ my $code = shift; { local $@; eval $code; if ( $@ ){ # print "\$@ = $@"; return (0, $@, "Comment the line with a # in front of it", + "perlintro" ); } else { # $code instead of 1?????? return (1, "code compiles correctly"); } } }

Implementation (current)

As you can see there is a lot PPI stuff but not exclusively. Tests are execuded in order from 001 to 00n and if a test fails the current mini program is rejected.

Each test can contain different steps, the first one being the optional run that simply sends the current code to a sub: this preliminary, optional test passes if the sub returns 1 and fails otherwise. Here it is used only to check if the program compiles ( see below for future ideas ).

The second step of a test is select_child_of and it expects a PPI class name and a serie of subtests. Each PPI element of the specified PPI class, for example PPI::Statement::Variable (a variable declaration) will be processed to see if they contains PPI elemnts which satisfy all subtests. The first PPI element passing all subtests is returned by select_child_of and becomes a candidate for further inspections.

Infact if evaluate_to is also specified, the current PPI element is, take a deep breath, keep calm, string evaluated to see if it holds the wanted value. And hic sunt leones or here are dragons because eval only returns the last statement value. Search the code above for the string dirty trick to see my workaround. For me it is a genial solution, but wait, I'm the guy who string eval'ed entire CPAN.. :) so improvements are warmly welcome.

This form of testing is a proof of concepts: is not the final form of the testing framework needed by Perl::Teacher

When a miniprogram passes all tests it is evaluated by Perl::Critic to give more hints to the student. Eventual policy violations will not make the program to be marked as wrong, but are just presented as suggestions.

A note about flexibilty: looking carefully at the assignement you will notice that @letters and $result are constraints. Not the same for the intermediate scalars containing the first element and the last one.

Implementation (future)

module design

The main Perl::Teacher module will provide only a framework to produce courses. The $teacher will load or create a configuration will have methods to deal with the student's input and to emit messages, but the main activity will be to load and follow courses plugins of the class Perl::Teacher::Course

In my idea the course creator will publish Perl::Teacher::Course::EN::BasicVariables or Perl::Teacher::Course::IT::RegexIntroduzione all being child of the main Perl::Teacher::Course class. These courses have to be pluggable to the $teacher object ( Module::Pluggable probably but I have to investigate it further)

Each course will contain a serie of lessons published a sub modules, as in Perl::Teacher::Course::EN::BasicVariables::01_strings , ..::02_lists etc.

Yes I know: very long names.. but this will ensure a clarity of intent and of usage, in my opinion.

( update October 14 2020 see the related question Module design for loadable external modules containing data )


Each lesson will contain an ordered serie of optional elements: zero one or more assignement, multiple test elements possibly interleaved by one or more discourse and direct question.

So a possible flow can be:

01 - discourse - introduction to the lesson 02 - discourse - more words 03 - assignement 04 - test 05 - test - more test 06 - test - test test ( block until all tests are ok ) 07 - discourse - explain and add a task 08 - assignement - the main assignement is updated 09 - test 10 - test - more test 11 - test - test test ( block until all tests are ok ) 12 - question 13 - question 14 - discourse - explaining answers ... nn - discourse - TIMTOWTDI nn - discourse - see also

Suggestions on module design are warmly welcome, but i want to keep it as simple as possible, not spawning objects for everything.


Tests presented in the above code are too semplicistics to cover each teaching activity. I need beside positive tests also negative ones for example to prevent the use of modules, or all modules but one, to prevent external program execution and so on. Theese tests will be quite on success and will emit messages only on failure: "dont do this!".

I can use Test::Script to add tests about correct overall syntax check, behaviour of STDOUT and STDERR given different arguments and so on.

Then Perl::Teacher will provide its own tests like ones presented above: evaluate_to ( evaluate_at is probably a better name as it eval the code at a certain line), is dirty but it seems to me a viable option not so risky given the super small and controlled environment. I also plan a method named evaluate_subs which will grab al subs to test them.

I have to mix all this features in a clean and easy to use interface. Suggetions are welcome.

student interaction

During a lesson the student must have the possibility to review the current assignement, to receive hints and be pointed to relevant documentation. Part of this is roughly done in the presented code using hints and docs embedded in tests. Can be and must be improved.

I like to add a TIMTOWTDI discourse at the end of each lesson showing more ways to accomplish, even if not in the very same way, the assignement.

Every output, comprensive of examined code, errors and hints, emitted during 03_array_manipulation must be saved into a 03_array_manipulation.history file so that the student can review the whole lesson including errors commited and pitfalls and the solution alongside different approaches to the same problem. Passing the time this becomes a good source of knoweledge.

further ideas

Testing standalone scripts is an idea haunting me since years. Modulino is an approach. I can be mad enough to take the original PDOM of a given program, then save all subs and use PPI method prune to delete them from the PDOM, then wrap the rest into a new main_original_program sub, add it to a new PDOM along with all previously saved subs. Then I could do the obtained file and test it nicely. A lot of cut 'n paste and probably error prone, but can be a path to explore.

I'd like also my Perl::Teacher to be as much possible input/output agnostic: implement a way to interact with the console leaving open the possibility to be used by a web interface too: how to do this?

I'd like to ear your opinions about this project, sugesstions on module design and implementation of its parts, comments to the above proof concepts and everything you want to share.


There are no rules, there are no thumbs..
Reinvent the wheel, then learn The Wheel; may be one day you reinvent one of THE WHEELS.

Replies are listed 'Best First'.
Re: automateaching -- part 2: proof of concept
by Tux (Abbot) on Sep 30, 2020 at 13:29 UTC

    Feel free to use in the TIMTOWTDI section :)

    Assignment should clearly state capitals or lower case. (assumed lower case below).

    This was too much of "I could not rest" to resist:

    Enjoy, Have FUN! H.Merijn
      Hello Tux,

      Thanks for sharing your TIMTOWTDIness :)

      Taking it seriously it demonstrate an important concept: learning is a path to follow, possibly alongside a teacher. Many of us can produce ten different ways to satisfy an assignment using perl. But this is not the point.

      As you noticed (lack of lower case specification for the array and the costraint of a single quote for the dash) it is very important to be clear in the assignement, making it also pedantic, and to be sure it imply the usage of already presented elements.

      A teacher must introduce concepts and verify how much students have incorporated them.

      Teaching, at first, is dedicated to fill ignorant's gap with notions and concepts (then teach how to learn and how to think, but is not my goal).

      So a course (in general but also mines) starts with assumed ignorance in one field, and step by step introduces elements and tests the overall students understanding.

      To produce PPI tests making all your example to be verified is an immane task, not worth even to plan. While teaching or learning the appropriate virtue is patience not hubris infact to learn is fondamental to recognize somethig superior who teach you.

      So I can add this note to my Perl::Teacher project:

      about assignements: -be sure to imply only already introduced elements, possibly refering +to the lesson where they were discussed -in the hints section put reminders to previous lessons -be pedantic in the assignement -possibly show up what was expected by tests when datastructures are i +nvolved (this can clarify an assignement)

      Tux!! out of the classroom!! :)


      There are no rules, there are no thumbs..
      Reinvent the wheel, then learn The Wheel; may be one day you reinvent one of THE WHEELS.

Log In?

What's my password?
Create A New User
Node Status?
node history
Node Type: perlmeditation [id://11122359]
Approved by marto
Front-paged by Corion
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others studying the Monastery: (3)
As of 2020-10-31 11:16 GMT
Find Nodes?
    Voting Booth?
    My favourite web site is:

    Results (288 votes). Check out past polls.