Fun with flags PL/SQL - what do you do that is unusual in PL/SQL? Disregarding the normal (and often boring) data processing that moves data around?
I would like to see people sharing their fun and unusual PL/SQL code in this thread. What weird stuff have you done in PL/SQL?
Okay, here is something I messed around - Richard Dawkins' weasel algorithm that uses software to emulate the basic principles found in Evolution. Was the 40th anniversary of Dawkins' "The Selfish Gene" a couple of months ago, which reminded me of my early attempts at writing code that simulates evolution, and Dawkins eye opening approaches to it.
The algorithm mutates an input string to the text "METHINKS IT IS LIKE A WEASEL" (quote from Shakespeare). Details can be read at https://en.wikipedia.org/wiki/Weasel_program.
Instead of doing this as a package, I tried a pure o-o approach using SQL types. Which was part of the fun - seldom get the opportunity to use o-o for PL/SQL solutions. Which is a pity as o-o is a great way to tackle data processing problems.
SQL> create or replace type TGene is object(
2 -- https://en.wikipedia.org/wiki/Weasel_program
3 generation integer, -- generation gene belongs to
4 gene_string varchar2(28), -- genetic string
5 gene_score integer, -- fitness score of genetic string
6
7 static function PerfectString return varchar2,
8 static function ValidChars return varchar2,
9 static function Mutation( geneString varchar2 ) return varchar2,
10 static procedure Assert( rule boolean, errCode integer ),
11 static procedure AssertValidGene( geneString varchar2 ),
12 static function RandomPercentage return integer,
13 static function RandomChar return varchar2,
14 static function Score( geneString varchar2 ) return integer,
15
16 constructor function TGene( parentGeneration integer, parentGene varchar2 ) return self as result
17 )
18 /
Type created.
SQL>
SQL> create or replace type TGeneTable is table of TGene;
2 /
Type created.
SQL>
SQL> set define on
SQL> set verify off
SQL> -- pretend header.h
SQL> define MUTATION_LIKELY=5 -- percentage of a char in string mutating
SQL> define MAX_CHILDREN=100 -- number of chilren per generation
SQL>
SQL> create or replace type body TGene as
2
3 -- the perfect string - the ultimate goal to mutate to
4 -- (aka fitness function target)
5 static function PerfectString return varchar2 is
6 begin
7 return( 'METHINKS IT IS LIKE A WEASEL' );
8 end;
9
10 -- only the following chars are allowed in a gene string
11 static function ValidChars return varchar2 is
12 begin
13 return( 'ABCDEFGHIJKLMNOPQRSTUVWXY ' );
14 end;
15
16 -- returns a random 0 to 100 percent
17 static function RandomPercentage return integer is
18 begin
19 return(
20 round(DBMS_RANDOM.value(0,100))
21 );
22 end;
23
24 -- returns a random char from the list of valid chars
25 static function RandomChar return varchar2 is
26 s varchar2(28);
27 begin
28 s := ValidChars;
29 return(
30 substr(s, round(DBMS_RANDOM.value(1,length(s))), 1)
31 );
32 end;
33
34 -- assert rule as true, else raise an exception
35 static procedure Assert( rule boolean, errCode integer ) is
36 type TErrorTable is table of varchar2(100);
37 errMsg constant TErrorTable :=
38 new TErrorTable(
39 'String must be 28 characters.',
40 'String contains invalid characters.'
41 );
42 begin
43 if not rule then
44 raise_application_error(
45 -20000 - errCode,
46 errMsg(errCode)
47 );
48 end if;
49 end;
50
51 static procedure AssertValidGene( geneString varchar2 ) is
52 begin
53 assert(
54 rule => nvl(length(geneString),0)=28,
55 errCode => 1
56 );
57
58 assert(
59 rule => translate(geneString,ValidChars,'') is null,
60 errCode => 2
61 );
62 end;
63
64 -- scores gene string :- 1 point for each correct char in the
65 -- the correct position
66 static function Score( geneString varchar2 ) return integer is
67 scoreNum integer;
68 godStr varchar2(28);
69 begin
70 assertValidGene( geneString );
71 godStr := PerfectString;
72 scoreNum := 0;
73 for i in 1 .. length(geneString) loop
74 if substr(geneString,i,1) = substr(godStr,i,1) then
75 scoreNum := scoreNum + 1;
76 end if;
77 end loop;
78
79 return( scoreNum );
80 end;
81
82
83 -- mutate gene string and returns the mutated string
84 static function Mutation( geneString varchar2 ) return varchar2 is
85 -- likelihood, as a %, of a char being replaced
86 -- by a random char
87 MUTATION_LIKELY constant integer := &MUTATION_LIKELY;
88
89 childString varchar2(28);
90 begin
91 assertValidGene( geneString );
92
93 -- there is a % change per char for mutating to a new random char
94 childString := geneString;
95 for i in 1 .. length(childString) loop
96 if RandomPercentage <= MUTATION_LIKELY then
97 -- replace char at position i with a random char
98 childString := substr(childString,1,i-1) ||
99 randomChar || substr(childString,i+1);
100 end if;
101 end loop;
102
103 return( childString );
104 end;
105
106 -- create MAX CHILDREN mutations for parent gene, and select the highest scoring mutation as
107 -- the fittest child that will serve as parent for the next generation
108 constructor function TGene( parentGeneration integer, parentGene varchar2 ) return self as result is
109 -- max children in a generation
110 MAX_CHILDREN constant integer := &MAX_CHILDREN;
111
112 childStr varchar2(28);
113 childScore integer;
114 begin
115 -- oracle bug: full explicit scope needed for referencing static class procedures,
116 -- thus the reference need to include schema owner name (schemaname=BILLY)
117 BILLY.TGene.assertValidGene( parentGene );
118
119 self.generation := nvl( parentGeneration+1, 0 );
120 self.gene_score := -1;
121 for i in 1 .. MAX_CHILDREN loop
122 -- 1 child is identical to parent, preventing wild mutations
123 -- from propogating as new generations when mutation % is high
124 -- within a generation
125 if i = 1 then
126 childStr := parentGene;
127 else
128 childStr := TGene.Mutation(parentGene);
129 end if;
130 childScore := TGene.Score(childStr);
131 if childScore > self.gene_score then
132 self.gene_score := childScore;
133 self.gene_string := childStr;
134 end if;
135 end loop;
136
137 return;
138 end;
139
140 end;
141 /
Type body created.
SQL> set define off
SQL>
SQL> create or replace function Evolution( startString varchar2 ) return TGeneTable pipelined is
2 -- pipeline takes a gene/string as input, and starts to evolve it to the perfect gene/string
3 gene TGene;
4 begin
5 -- seed the randomiser, ensuring same response for a specific start string each time around,
6 -- thereby killing Schrödinger's cat (take that superposition!)
7 DBMS_RANDOM.Seed( startString );
8
9 gene := new TGene( 0, startString, TGene.Score(startString) );
10 pipe row( gene );
11
12 while gene.gene_score != 28 loop
13 gene := new TGene( gene.generation, gene.gene_string );
14 pipe row( gene );
15 end loop;
16
17 return;
18 end;
19 /
Function created.
The pipeline serves as a factory - it instantiates gene objects, and mutate these via the gene class, until the fitness function (perfect string) is satisfied.
Here it takes 82 generations to reach the perfect string. Not sure what Dawkins's constants were for the algorithm, as his attempt used less generations. But then I also seed the randomiser using the original string - which ensures that the pipeline's evolution process is identical for the same origin string. Useful when messing with the 2 parameters of this algorithm - the percentage chance that a gene char mutates, and the size of the population of a generation.
SQL> -- the string originally used by Dawkins
SQL> select * from table(Evolution('WDLTMNLT DTJBKWIRZREZLMQCO P'));
GENERATION GENE_STRING GENE_SCORE
---------- ---------------------------- ----------
0 WDLTMNLT DTJBKWIRZREZLMQCO P 3
1 WDLTMNLT DTJBKWIRZREZLMQAO P 4
2 WELTMNLT DTJBKWIRZSEZLMQAO P 5
3 WELTMNLT ITJBKWIRZSEZLMQAO P 6
4 WELTMNLT ITJBKWIRZSEZ MQAP P 7
5 WELTMNLT ITJBKWIRZSEZ MQAP P 7
6 WELTMNLT ITJBKWIRZSEZ WQAP P 8
7 WEKTMNLK ITJVKWIRZEEZ WFAC C 9
8 WETTMNLK ITJVKWIRZEEZ WFAC C 10
9 WETTMNLK ITJVSGIKZEEZ WFAC C 11
10 WETHMNLK ITJVSGIKZEEZ WFAC C 12
11 WETHMNLK ITJVSGIKZEEZ WFAC C 12
12 WETHMNLK ITJVS IKZEEE WFAC C 13
13 WETHMNLK ITJVS IKZEEE WFAC C 13
14 WETHMNLK ITJVS IKZEEE WFAC L 14
15 WETHMNLK IT VS IKZEEE WFAC L 15
16 WETHMNLK IT VS IKZEEE WFAC L 15
17 WETHMNLS IT VS IKZEEE WFAC L 16
18 WETHMNLS IT VS IKZEEE WFAC L 16
19 WETHNNQS IT VS IKZEEE WFAS L 17
20 WETHNNQS IT VS IKZEEE WFAS L 17
21 WETHNNQS IT VS IKZEEE WFAS L 17
22 WETHNNQS IT VS IKZEEE WFAS L 17
23 WETHNNQS IT IS IKZEEE WFASXL 18
24 WETHNNQS IT IS IKZEEE WFASXL 18
25 WETHNNQS IT IS IKZEEE WEASXL 19
26 WETHNNQS IT IS IKZEEE WEASXL 19
27 WETHNNQS IT IS IIZEEE WEASXL 20
28 WETHNNQS IT IS IIZEEE WEASXL 20
29 METHNNQS IT IS IIZEEE WEASXL 21
30 METHNNQS IT IS IIZEEE WEASXL 21
31 METHNNQS IT IS IIZEEE WEASXL 21
32 METHNNQS IT IS IIZEEE WEASXL 21
33 METHNNQS IT IS LIZEEE WEASXL 22
34 METHNNQS IT IS LIZEEE WEASXL 22
35 METHNNQS IT IS LIZE E WEASXL 23
36 METHNNQS IT IS LIZE E WEASXL 23
37 METHNNQS IT IS LIZE E WEASXL 23
38 METHNNQS IT IS LIZE E WEASXL 23
39 METHNNQS IT IS LIZE E WEASXL 23
40 METHINQS IT IS LIZE E WEASXL 24
41 METHINQS IT IS LIZE E WEASXL 24
42 METHINQS IT IS LIZE E WEASXL 24
43 METHINQS IT IS LIZE E WEASXL 24
44 METHINQS IT IS LIZE E WEASXL 24
45 METHINQS IT IS LIZE E WEASXL 24
46 METHINQS IT IS LIZE E WEASEL 25
47 METHINQS IT IS LIZE E WEASEL 25
48 METHINQS IT IS LIZE E WEASEL 25
49 METHINQS IT IS LIZE E WEASEL 25
50 METHINQS IT IS LIZE E WEASEL 25
51 METHINQS IT IS LIZE E WEASEL 25
52 METHINQS IT IS LIZE E WEASEL 25
53 METHINQS IT IS LIZE E WEASEL 25
54 METHINQS IT IS LIZE E WEASEL 25
55 METHINQS IT IS LIZE E WEASEL 25
56 METHINQS IT IS LIZE E WEASEL 25
57 METHINQS IT IS LIZE E WEASEL 25
58 METHINQS IT IS LIZE E WEASEL 25
59 METHINQS IT IS LIZE E WEASEL 25
60 METHINQS IT IS LIZE E WEASEL 25
61 METHINQS IT IS LIZE E WEASEL 25
62 METHINQS IT IS LIZE E WEASEL 25
63 METHINQS IT IS LIZE E WEASEL 25
64 METHINKS IT IS LIZE E WEASEL 26
65 METHINKS IT IS LIZE E WEASEL 26
66 METHINKS IT IS LIZE E WEASEL 26
67 METHINKS IT IS LIZE E WEASEL 26
68 METHINKS IT IS LIZE E WEASEL 26
69 METHINKS IT IS LIZE E WEASEL 26
70 METHINKS IT IS LIKE E WEASEL 27
71 METHINKS IT IS LIKE E WEASEL 27
72 METHINKS IT IS LIKE E WEASEL 27
73 METHINKS IT IS LIKE E WEASEL 27
74 METHINKS IT IS LIKE E WEASEL 27
75 METHINKS IT IS LIKE E WEASEL 27
76 METHINKS IT IS LIKE E WEASEL 27
77 METHINKS IT IS LIKE E WEASEL 27
78 METHINKS IT IS LIKE E WEASEL 27
79 METHINKS IT IS LIKE E WEASEL 27
80 METHINKS IT IS LIKE E WEASEL 27
81 METHINKS IT IS LIKE E WEASEL 27
82 METHINKS IT IS LIKE A WEASEL 28
83 rows selected.
SQL>
Would be fun to do biomorps too - but then there is a visual component to it that cannot really be done justice to, using PL/SQL.