Programmer's Garden

Perl - 636

There is definitely some more golfing that can be done. And probably better ways to do it too.

<>;while(<>){if(/ /){chomp;push@v,$_}else{$t.=$_}}for(@v){r(split/ /)}say$t.$y."total cost $u";sub r{my($e,$w,$c,$h,$z)=@_;($i,$f,$q,$d)=(1,0,0,"."x$e);@m=($c=~/($d)/g);@l=split/\n/,$t;while($i>0){($g,$j)=(1,0);for(0..$#l){if($j==0&&$l[$_]=~/^(.*?)\.\Q$m[$j]\E\./){$j++;$l="."x length$1}elsif($j<@m&&$l[$_]=~/^$l\.\Q$m[$j]\E\./){$j++}elsif($j>0){$l[$_-1]=~s!.\Q$m[$j-1]\E.!" ".$m[$j-1]=~s/\./ /gr." "!e;($j,$g)=(0,0)}if($j==@m){$k=$j;for($f=$_;$f>$_-$j;$f--){$k--;$o="."x length$m[$k];$l[$f]=~s/^($l)\.\Q$m[$k]\E\./$1.$o./}($g,$j)=(0,0);$q++}}if($g){$i--}}$t=join("\n",@l)."\n";$t=~s/ /./g;$p=$z*$q;$u+=$p;$y.="$q $h at $z costs $p\n"}

635 characters + 1 for -C flag to handle the euros.

If you have the input stored in input.txt you can run it with:

cat input.txt | perl -C -E'<>;while(<>){if(/ /){chomp;push@v,$_}else{$t.=$_}}for(@v){r(split/ /)}say$t.$y."total cost $u";sub r{my($e,$w,$c,$h,$z)=@_;($i,$f,$q,$d)=(1,0,0,"."x$e);@m=($c=~/($d)/g);@l=split/\n/,$t;while($i>0){($g,$j)=(1,0);for(0..$#l){if($j==0&&$l[$_]=~/^(.*?)\.\Q$m[$j]\E\./){$j++;$l="."x length$1}elsif($j<@m&&$l[$_]=~/^$l\.\Q$m[$j]\E\./){$j++}elsif($j>0){$l[$_-1]=~s!\Q$m[$j-1]\E!$m[$j-1]=~s/\./ /gr!e;($j,$g)=(0,0)}if($j==@m){$k=$j;for($f=$_;$f>$_-$j;$f--){$k--;$o="."x length$m[$k];$l[$f]=~s/^($l)\.\Q$m[$k]\E\./$1.$o./}($g,$j)=(0,0);$q++}}if($g){$i--}}$t=join("\n",@l)."\n";$t=~s/ /./g;$p=$z*$q;$u+=$p;$y.="$q $h at $z costs $p\n"}'

Here is the deparsed version. I went through and added some comments to help explain things. Maybe I'll go make the variable names more readable sometime. There may be some edge cases this doesn't work with but it works with the examples at least.

BEGIN { # These are the features we get with -C and -E flags
    $^H{'feature_unicode'} = q(1); # -C gives us unicode
    $^H{'feature_say'} = q(1); # -E gives us say to save 1 character from print
    $^H{'feature_state'} = q(1);
    $^H{'feature_switch'} = q(1);
}
<ARGV>; # throw away the first line
while (defined($_ = <ARGV>)) { # read the rest line by line
    if (/ /) { # if we found a space (the garden doesn't have spaces in it)
        chomp $_; # remove the newline
        push @v, $_; # add to our array
    }
    else { # else, we construct the garden
        $t .= $_;
    }
}
foreach $_ (@v) { # call the subroutine r by splitting our input lines into arguments
    r(split(/ /, $_, 0)); # the arguments would be like r(3,2,".R.\|/","rouge_flower",3)
}
say $t . $y . "total cost $u"; # print the cost at the end

# this subroutine removes weeds from the garden and counts them
sub r {
    BEGIN {
        $^H{'feature_unicode'} = q(1);
        $^H{'feature_say'} = q(1);
        $^H{'feature_state'} = q(1);
        $^H{'feature_switch'} = q(1);
    }
    my($e, $w, $c, $h, $z) = @_; # get our arguments
    ($i, $f, $q, $d) = (1, 0, 0, '.' x $e); # initialize some variables
    @m = $c =~ /($d)/g; # split a string like this .R.\|/ into .R. and \|/
    @l = split(?\n?, $t, 0); # split the garden into lines to process line by line
    while ($i > 0) {
        ($g, $j) = (1, 0);
        foreach $_ (0 .. $#l) { # go through the garden
            if ($j == 0 and $l[$_] =~ /^(.*?)\.\Q$m[$j]\E\./) { # this matches the top part of the weed. \Q and \E make it so the weed isn't intepreted as a regex. Capture the number of dots in front of it so we know where it is
                ++$j;
                $l = '.' x length($1); # this is how many dots we have
            }
            elsif ($j < @m and $l[$_] =~ /^$l\.\Q$m[$j]\E\./) { # capture the next line
                ++$j;
            }
            elsif ($j > 0) { # if we didn't match we have to reset
                $l[$_ - 1] =~ s[.\Q$m[$j - 1]\E.][' ' . $m[$j - 1] =~ s/\./ /rg . ' ';]e; # this line replaces the dots next to the weed and in the weed with spaces
                # to mark it since it didn't work but the top part matches
                # that way when we repeat we go to the next weed
                ($j, $g) = (0, 0);
            }
            if ($j == @m) { # the whole weed has been matched
                $k = $j;
                for ($f = $_; $f > $_ - $j; --$f) { # remove the weed backwards line by line
                    --$k;
                    $o = '.' x length($m[$k]);
                    $l[$f] =~ s/^($l)\.\Q$m[$k]\E\./$1.$o./; 
                }
                ($g, $j) = (0, 0);
                ++$q;
            }
        }
        if ($g) {
            --$i; # all the weeds of this type are gone
        }
    }
    $t = join("\n", @l) . "\n"; # join the garden lines back together
    $t =~ s/ /./g; # changes spaces to dots 
    $p = $z * $q; # calculate cost
    $u += $p; # add to sum
    $y .= "$q $h at $z costs $p\n"; #get message
}

Feel free to suggest improvements!

Tags:

Code Golf