Some mathematical notes on a polargraph

... and physics too

A V-Bot is a simple drawing machine based on two-center bipolar coordinates. Here's some web references:

The layout of a V-Bot is quite simple, two motors at the upper vertices at a distance d, with two strings attached with lengths l1 and l2. The drawing pen rests at (x,y).

Problems to solve

The typical math problems associated with robots are two: direct and inverse kinematics. In this particular case the inverse kinematics is easy to obtain, given the pen position obtain the lengths of the strings:

latex2png equation

I'm using GNU/Octave, so here's some auxiliary functions:

function retval=l1c(x,y,d)
  retval= sqrt(y.^2+(x+d/2).^2);
end
function retval=l2c(x,y,d)
  retval= sqrt(y.^2+(x-d/2).^2);
end

These equations define a map from the cartesian coordinates (x,y) to (l1,l2).

For the direct kinematics one has, with some simple algebra, latex2png equation

Drawing resolution

One can tackle the problem of finding the resolution in two ways. Using the Jacobian and the arc length of a curve.

The Jacobian

The Jacobian latex2png equation defines the ratio of a unit area in both coordinates. That is, it controls what happens (direct kinematics) when a unit area in (l1,l2) coordinates is transformed in to (x,y) coordinates, it expands, contracts or stays the same. Values for J greater than one gives an area expansion, lower than one the area is reduced. The Jacobian controls the resolution of the drawing region.

What happens when the Jacobian is zero? In simple terms it means that the transformation breaks, i.e. one can not use the transformation between (x,y) and (l1,l2) to control the robot, and so at the points or at the lines where Jacobian is zero the robot can not be controlled (you can guess by simple inspection, with no math, what these lines/points are ;) ).

The Jacobian latex2png equation is given by latex2png equation

The next image shows the value of this Jacobian as a function of (x,y)

The code for the Jacobian J(x,y,l1,l2) is given by

function retval=jac(x,y,d)
  retval=2*1c(x,y,d).*l2c(x,y,d)./(d*y);
end

For the inverse kinematics the Jacobian is the reciprocal of J(x,y,l1,l2), that is 1/J(x,y,l1,l2). In this case one gets

As expected (see pics) the problematic lines are l1+l2=d or simply the line y=0 for any x.

The previous plots shows the "good" areas for drawing, somewhere below the y=0 line (10cm?). Will see the same result when considering the tension on the strings (see below).

The arc length of a curve

The the arc length of a curve can be used to determine the "good" plotting region for the robot. This is done by taking the first order Taylor expansion of the direct and inverse kinematics equations. This however requires some prior considerations.

Because the relation between (x,y) and (l1,l2) is non-linear any variation (x,y) will produce a non-linear variation in (l1,l2) this variation is path dependent, the propagation of the variations depends if, for example, the pen goes right and then up or by the hypotenuse to the same point on the drawing board.

latex2png equation and latex2png equation

Here goes:

function retval=lenghtl(x,y,dx,dy,d)
  dl1=(y.*dy+(x+d/2).*dx)./l1c(x,y,d);
  dl2=(y.*dy+(x-d/2).*dx)./l2c(x,y,d);
  retval=sqrt((dl1.^2+dl2.^2)/(dx.^2+dy.^2));
end
function retval=lenghtxy(x,y,dl1,dl2,d)
  dx=l1c(x,y,d)./d.*dl1 - l2c(x,y,d)./d.*dl2;
  dy=l1c(x,y,d).*(1-2*x/d)./(2*y).*dl1 + l2c(x,y,d).*(1+2*x/d)./(2*y).*dl2;
  retval=sqrt((dx.^2+dy.^2)/(dl1.^2+dl2.^2));
end

The next plot shows the ratio of unit lengths in the direct kinematics plotted in the (x,y) plane by taking the average on the 4 movements of the pen (right,0), (left,0), (0,up) and (0,down)1.

The next plot takes the average length on 4 movements of the pen (left,up), (right,up), (left,down) and (right,down)2.

This last plot is similar to the final plot obtained by Bill Rasmussen. My point is that in this way we only account for the variation of the length of a straight segment in this coordinate transformation. Obviously the length changes after the transformation due to the non-linearity of the transformation and reflects the loss of resolution but the right way to determine the resolution is using the Jacobian.

The ends of the control lines in the above picture seem to be further away from the plotting surface than V plotters commonly seen on the internet.

That's just because the important tool to measure resolution is the Jacobian, even thought many of the V-Bot builders do not know about it ;)

What about the tension on the strings?

One should also take into account the tension on each string. With some trigonometry one gets

latex2png equation

There's only one singular configuration that one should take note, the case latex2png equation which yields latex2png equation

function retval=tension(x,y,d)
  m=1;
  g=1;
  l1=sqrt(y.^2+(d/2-x).^2);
  l2=sqrt(y.^2+(d/2+x).^2);       
  cosa1=(d/2+x)./l1;
  cosa2=(d/2-x)./l2;
  sina1=y./l1;
  sina2=y./l2;
  
  T1=m*g*cosa2./(cosa1.*sina2+cosa2.*sina1);
  T2=m*g*cosa1./(cosa1.*sina2+cosa2.*sina1);
  retval=sqrt(T1.^2+T2.^2);
end

This is shown in the following plot:

Also the cases of null tension on one of the strings latex2png equation, latex2png equation or latex2png equation, latex2png equation yields, respectivly, latex2png equation and latex2png equation or latex2png equation and latex2png equation.

1. Vertical displacements: (right,0), (left,0), (0,up) and (0,down)

2. Oblique displacements: (left,up), (right,up), (left,down) and (right,down)

Refs.:

Tags: v-bot, dc motor, math, physics, polargraph

2026/02/16-16:01:06

Fotografias variadas

Fotografias várias

; INVALID LISP CODE

Tags: fotografias

2026/02/16-16:01:06

ToDo

Coisas ainda por fazer, tecnicidades web para o blog.

Coisas ainda por fazer, tecnicidades web para o blog

  • Incluir no *header* de cada página:
    • as keywords para cada página;
    • o link de rss;
    • o ico ;
  • Gerar RSS com as *tags* usando as *keywords*.
  • Incluir radiciação em Português com o algoritmo de Porter para cada página gerada.
  • incluir uma secção de notas breves com feed para o Twitter.
  • Gerar index por categorias/keywords/tags

Tags: blog, web, rss, todo

2026/02/16-16:01:06

Thank you

Thanks you...

Thank you for contacting me I will reply as soon as possible.

Cheers.

Tags: thanks

2026/02/16-16:01:06

Test

// Author: Tiago Charters
// Maintainer: Tiago Charters
// Copyright (c) - 2023 Tiago Charters de Azevedo (tiagocharters@nextp.pt)
// This program is free software; you can redistribute it and/or modify
// it under the terms of the GNU General Public License as published by
// the Free Software Foundation; either version 3, or (at your option)
// any later version.

// This program is distributed in the hope that it will be useful,
// but WITHOUT ANY WARRANTY; without even the implied warranty of
// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
// GNU General Public License for more details.

// You should have received a copy of the GNU General Public License
// along with this program; if not, write to the Free Software
// Foundation, Inc., 51 Franklin Street, Fifth Floor,
// Boston, MA 02110-1301, USA.

////////////////////////////////////////////////////////////

phi=1.618;
b=20;
h=10*phi;
rc=.1*h;

////////////////////////////////////////////////////////////
//cellphone dimensions (mm)
////////////////////////////////////////////////////////////
l=160;
c=2*50;
d=40;
hc=10;
theta=20; //tilt angle
a=l/2*cos(theta);

module phonestand(){
    difference(){
        minkowski(){
            cube([a-2*rc,b-2*rc,h-2*rc],center=true);
            sphere(rc,$fn=64);}
        // cellphone
        translate([a/2*cos(theta)-2*rc-hc/2,0,0])
        rotate([0,-theta,0])
        hull(){
            translate([0,0,l])
            rotate([90,0,0])    cylinder(h=50,r=hc/2,center=true);
            rotate([90,0,0])    cylinder(h=50,r=hc/2,center=true);}

        translate([0,0,-h+rc*(1-sqrt(2)/2)])
        cube([a+1,a,h],center=true);

        translate([-b/2,0,0*h/2])
        minkowski(){
            cube([a/1.707-2*rc,b/2-2*rc,10*h-2*rc],center=true);
            sphere(rc,$fn=64);}
    }
}

phonestand();




latex2png equation latex2png equation

plate 14

sometimes we see a cloud objk

Tags:

2026/02/16-16:01:06


Aula nº 2
Impressoras RepRap, Cadeia de software (cad, stl, slicer, print), Firmware, g-code.
Tarefa
Escolher uma impressora "preferida" (ver lista anterior); apresentações e justificações.
Aula nº 3
Oficina Digital do ISEL, projectos de antigos alunos, impressoras RepRap disponíveis, início d e discussão

Aula nº 3 (19/10/2020)
Apresentação de RepRap escolhidas; discussãos sobre os suportes de telemóveis.

Aula nº 4 e 5 (20/10/2020)
Apresentação de RepRap; Slicer: slic3r; novo projecto.

Tarefa: Conclusão do mini-projecto: desenhar e imprimir um suporte para telemóvel. Início de novo procjeto com tema UpCycle

Algumas referências para este projecto:


Aula nº 6 (26/10/2020)
Discussão final dos modelos para impressão 3D. Novo projecto upcycling.

Aula nº 7 (02/11/2020)
Discussão final dos modelos para impressão e discussão de modelos já impressos.

Aula nº 8 (02/11/2020)
Projecto upcycling, propostas e dificuldades. Bibliotecas Openscad: BOSL, dotSCAD, NopSCADlib, BOLTS. MOST. Threads.
Tarefa para a próxima aula:
Dar uma espreitadela no blog HydraRaptor.
Aula nº 9 (02/11/2020)
Projecto upcycling; contrução exemplos.

Aula nº 10 (09/11/2020)
Fim do projecto de upcycling. Introdução de novo projecto: abcdário mecânico.

Referências adicionais

Modulo: RepRap

  1. RepRap, The RepRap project: an open source/open hardware movement for 3D-printing, Printrun
  2. Marlin 3D print firmware, LULZbot CURA, slic3r, Ultimaker Cura
  3. Construção de uma RepRap

Hardware OpenSource

Comunidade

CAD OpenSource

  1. OpenSCAD, OpenSCAD User Manual, MOST SCAD Libraries on Github, Blender, FreeCAD

Open Source Appropriate Technology

Outras coisas



Utilidades OpenSCAD

//
// Mendel90
//
// GNU GPL v2
// nop.head@gmail.com
// hydraraptor.blogspot.com
//
// See http://hydraraptor.blogspot.com/2011/02/polyholes.html
//

function sides(r)=max(round(4*r),3);
function corrected_radius(r,n=0)=0.1+r/cos(180/(n ? n : sides(r)));
function corrected_diameter(d)=0.2+d/cos(180/sides(d/2));

module poly_circle(r,center=false){
    n=sides(r);
    circle(r=corrected_radius(r,n),$fn=n,center=center);}

module poly_cylinder(h,r,center=false){
    n=sides(r);
    cylinder(h=h,r=corrected_radius(r,n),$fn=n,center=center);}

module poly_d_cylinder(r,center=false){
    n=sides(r);
    r=corrected_radius(r,n);
    cylinder(h=h,r=r,$fn=n,center=center);
    translate([0,-r,0])
    cube([r,2*r,h]);}


module poly_sphere(r,center=false){
    n=sides(r);
    sphere(r=corrected_radius(r,n),$fn=n,center=center);}

https://en.wikiversity.org/wiki/Open_Source_3-D_Printing#Module_0:_RepRap_Build https://docs.google.com/document/d/1X_5jd2Rn8OTCEUf-uO7pvVTAfawgpHSvyQUH-Sm1sbA/edit

</comment>

Tags:

2026/02/16-16:01:06

Setar geometric construction

... simple

Simple geometry using an real setar.
Simple geometry using an real setar.
Geometric construction.
Geometric construction.
Geometric construction (more detail).
Geometric construction (more detail).
Geometric construction (more detail).
Geometric construction (more detail).

ç

Tags: setar, geometry

2026/02/16-16:01:06

Setar

Setar photos

High res photos

Tags: setar

2026/02/16-16:01:06

Sandbox

Writing on sand

latex2png equation

Tags: sandbox

2026/02/16-16:01:06

Romanillos guitar geometry

Looks simple...

ç

Tags: Romanillos, guitar, geometry

2026/02/16-16:01:06

◍ - rndf3 (300x300mm, Ballpoint pen on paper)

rndf3 | Ballpoint pen on paper | 300x300mm

rndf3 | rndf3
Esferográfica em papel | Ballpoint pen on paper (300x300mm)
[-]
Tags:
2026/02/16-16:01:06

◍ - rndf2 (300x300mm, Ballpoint pen on paper)

rndf2 | Ballpoint pen on paper | 300x300mm
rndf2 | rndf2
Esferográfica em papel | Ballpoint pen on paper (300x300mm)
[-]
Tags:
2026/02/16-16:01:06

◍ - rndf1 (300x300mm, Ballpoint pen on paper)

rndf1 | Ballpoint pen on paper | 300x300mm
rndf1 | rndf1
Esferográfica em papel | Ballpoint pen on paper (300x300mm)
[-]
Tags:
2026/02/16-16:01:06

◍ Polargraphy - rnd (Canson 200g acid free paper, 297x420mm, Ballpoint pen on paper)

rnd | rnd | Canson 200g acid free paper, 297x420mm
rnd | rnd
Esferográfica em papel | Ballpoint pen on paper (Canson 200g acid free paper, 297x420mm)
[-]
Tags:
2026/02/16-16:01:06

02 E o seu maior defeito? Honestidade.

03 A coisa mais importante num homem? Honestidade.

04 E numa mulher? Honestidade.

05 O que é que mais aprecia nos seus amigos? Honestidade.

06 A sua actividade favorita é... pensar.

07 Qual é a sua ideia de felicidade? Estar quieto.

08 E o que seria a maior das tragédias? Morrer entretanto.

09 Quem você gostaria de ser, se não fosse você mesmo? Outro qualquer.

10 E onde gostaria de viver? No campo.

11 Qual é a sua cor favorita? #f5f5f5

12 E a flor? Papoila.

13 Um pássaro? Um pardal.

14 Os seus autores preferidos? Goethe, Fernando Pessoa

15 E os poetas de que mais gosta? Fernando Pessoa, David Mourão Ferreira,

16 Quem são os seus heróis de ficção? Fausto

17 E as heroínas?

18 O seu compositor favorito é... J. S. Bach

19 E os pintores de que mais gosta? Van Gogh

20 Quem são as suas heroínas na história?

21 E os heróis na vida real?

22 Quais são os seus nomes preferidos?

23 O que é que mais detesta? Paradoxos

24 Quais são as personagens históricas que mais despreza?

25 Que evento na história militar mais admira?

26 Que reforma mais admira?

27 Quais os dons da Natureza que gostaria de possuir?

28 Como gostaria de morrer?

29 Qual é o seu estado de espírito?

30 Com que falhas é mais indulgente? Quase todas.

31 Qual é o lema da sua vida? Não há lemas na vida.

Tags:

2026/02/16-16:01:06

Projectos LMATE (2021/22)

Propostas de projectos finais de licenciatura LMATE/ISEL

Nesta página estão disponíveis as propostas para os projectos finais de Licenciatura Matemática Aplicada à Tecnologia e à Empresa do ISEL (ano lectivo 2021/2022).

Para informações ou questões: tiago.charters.azevedo@isel.pt


Estudo e modelação geométrica de estruturas de preenchimento variável em impressão 3D.

O infill dos objectos usados em impressão 3D tem uma influência determinante na rigidez mecânica, no seu desempenho funcional e sustentabilidade na utilização do plástico. Neste projecto pretende-se construir e implementar um algoritmo de infill, usando algoritmos de computação gráfica, que permita parametrizar diversas curvas arbitrárias para preenchimentos. Estes infill serão depois testados por impressão 3D na Oficina Digital do ISEL.

Exemplos típicos impressos em 3D por Fused Deposition Modeling (FDM).

Refs.:

J. Prša, J. Müller, F. Irlinger and T. C. Lueth, Evaluation of the infill algorithm fortrajectory planning of pointed ends for droplet-generating 3D printers, 2014 IEEE Inter-national Conference on Robotics and Biomimetics (ROBIO 2014), 2014, pp. 1560-1565, https://doi.org/10.1109/ROBIO.2014.7090556

Alexios Papacharalampopoulos, Harry Bikas, Panagiotis Stavropoulos, Path planning for the infill of 3D printed parts utilizing Hilbert curves, Procedia Manufacturing, Volume 21, 2018, pp. 757-764, https://doi.org/10.1016/j.promfg.2018.02.181


Parametrização e desenho automático de conectores para impressão 3D

Treliças são sistemas constituídos por elementos indeformáveis (barras) unidos entre si por junções e sujeitos apenas a cargas aplicadas nos nós. Assim as barras ficam exclusivamente sujeitas a esforços normais de tracção ou compressão. Neste projecto pretende-se implementar em OpenSCAD (http://openscad.org/) um algoritmo para desenho automático de todos os conectores (nós) para impressão 3D para uma dada treliça. As impressões 3D serão realizadas na Oficina Digital do ISEL.

Simulações em OpenSCAD:

Torus de Mobius

Dodecaedro

Refs.:

Trammell Hudson’s OpenSource Projects https://github.com/osresearch/papercraft


Autómatos celulares e impressão 3D

As impressoras 3D são usualmente usadas para impressão de objectos desenhados deterministicamente por software CAD. Com velocidade e extrusão constantes as impressões 3D por Fused Deposition Modeling (FDM) permitem gerar padrões auto-organizados semelhantes à dinâmica de autómatos celulares estocásticos de dimensão 1.

O objectivo deste projecto consiste em catalogar e tipificar as classes de equivalência dos diferentes padrões e estruturas obtidas usando autómatos celulares estocásticos de dimensão 1 como modelo teórico descritivo. As impressões 3D serão realizadas na Oficina Digital do ISEL.

Refs.:

Kanada, Y., 3D printing and simulation of naturally randomized cellular automata, ArtifLife Robotics 19, 311–316 (2014). https://doi.org/10.1007/s10015-014-0182-9

Tags: LMATE, ISEL

2026/02/16-16:01:06

Programas para download

Programas para download em GNU/Octave

Costumo escrever muitos programas em GNU/Octave. Na maioria dos casos relacionados com a minha actividade de docência (métodos numéricos). Claro, todos sob um licença GNU General Public License (GPL).

É dada permissão para copiar, distribuir e/ou modificar todos os programas/textos aqui disponibilizados nos termos da GNU GENERAL PUBLIC LICENSE Versão 3 ou qualquer outra versão posterior publicada pela Free Software Foundation. Uma cópia da licença - GNU GENERAL PUBLIC LICENSE.

Notas:

  1. A data referida corresponde à última modificação do programa.
  2. De modo a não permitir que o Octave quebre as linhas é necessária a instrução split_long_rows=0.
  3. Os métodos seguintes implementados foram pensados para uso demonstrativo, por isso, para os correr é necessário formatar o output usando o comando format short g.
  4. Os programas não foram escritos a pensar na compatibilidade entre o programa Matlab e o GNU/Octave no entanto a compatibilidade por ser obtida com as seguintes substituições:
endif        ->  end
endfor       ->  end
endfunction  ->  end

GNU/Octave

Métodos numéricos básicos

BISSEC (ficheiro auxiliar F)
Método da bissecção (Agosto 2007)
FPOINT (ficheiro auxiliar F)
Método do ponto fixo (Agosto 2007)
SECANT (ficheiro auxiliar F)
Método da secante (Agosto 2007)
REGULAFALSI (ficheiro auxiliar F)
Método da falsa posição (Agosto 2007)
NEWTON (ficheiro auxiliar F, DF)
Método de Newton (Agosto 2007)
NEWTONSYS (ficheiro auxiliar FFUN, JFUN)
Método de Newton para sistemas de equações não lineares (Agosto 2007)
LSQUARE
Método dos mínimos quadrados (Agosto 2007)
NEWTONDD
Diferenças divididas (Agosto 2007)
GAUSSEL
Solução de um sistema linear por condensação de Gauss (Agosto 2007)
GAUSSELK
Solução de um sistema linear por condensação de Gauss (mostra explicitamente cada passo) (Agosto 2007)
JACOBI
Método de Jacobi - solução de um sistema linear (Agosto 2007)
GAUSSSEIDEL
Método de Gauss-Seidel - solução de um sistema linear (Agosto 2007)
INTERPFRAC, Ref: Michael Barnsley, Fractals Everywhere, Academic Press, 1988
Interpolação fractal (Agosto 2007)
INTTRAP (ficheiro auxiliar F)
Integração numérica - regra dos trapézios (simples e composta) (Agosto 2007)
INTSIMPSON (ficheiro auxiliar F)
Integração numérica - regra de Simpson (simples e composta) (Agosto 2007)

Matrizes especiais

REULER
Matriz de rotação 3D em termos de ângulos de Euler (Julho 2007)
RQUAT
Matriz de rotação 3D em termos de quaterniões (Julho 2007)
QUAT2EULER
Mudança de variáveis - quaterniões para ângulos de Euler (Julho 2007)

Funções especiais

GAMMACONST
Constante de Euler (Agosto 2007)
POLYVALB (ficheiro auxiliar F)
Polinómios de Bernstein (Agosto 2007)
LAMBERT Ref: Robert M. Corless, G. H. Gonnet, D. E. G. Hare, D. J. Jeffrey, and D. E. Knuth, "On the Lambert W Function", Advances in Computational Mathematics, volume 5, 1996, pp. 329--359.
Função Lambert W0 (implementação muito ingénua, mas tem, no entanto, uma precisão de 10^-12) (Outubro 2007)
HAAR
Coeficientes da decomposição em wavelets (Haar) (Novembro 2007)
HAARVAL
Calcula o valor de f dados os coeficientes da decomposição em wavelets (Haar) (Novembro 2007)
GETSTEPS
Calcula o valor dos degraus da decomposição em wavelets (Haar) (Novembro 2007)
PLOTHAAR
Exemplos da decomposição em wavelets (Haar) (Novembro 2007)

Fractais

RANDINT
Gerador aleatório de um inteiro k entre 1 e n, com probabilidade dada por um vector p=(p1,p2,...,pn). (Agosto 2007)
RANDITERALG (ficheiros auxiliares: FERN, SIERP, SIERP3) Ref: Michael Barnsley, Fractals Everywhere, Academic Press, 1988
"Random iteration algorithm". (Outubro 2007)

Jogos

MONTY (ficheiro auxiliar COINFLIP)
Prova empírica do problema de Monty Hall (Abril 2008)

Super fórmulas

SF2D
Super fórmula 2D (Novembro 2008)
SF3D
Super fórmula 3D (Novembro 2008)

Super quádricas

SUPERHYPER
Super hiperboles (Novembro 2008)
SUPERELLIPSE
Super elipses (Novembro 2008)
SUPERTOROID
Super torus (Novembro 2008)

Tags: GNU/Octave, programas, download

2026/02/16-16:01:06

Potpourri guitar circuits

found on the web (copyright of the stated owners)

; INVALID LISP CODE

ç

Tags: guitar, diy, circuits

2026/02/16-16:01:06

Potpourri guitar circuits

found on the web (copyright of the stated owners)

; INVALID LISP CODE

ç

Tags: guitar, diy, circuits

2026/02/16-16:01:06

Algumas funções em Lisp para o algoritmo de Porter

A ideia e a vontade "numa mão cheia" de funções em Emacs lisp.

(setq max-lisp-eval-depth 100000
      max-specpdl-size 10000)

Funções auxiliares

(defun list-to-string (l)
  "Return a STRING which is the concatenation of the elements of
L."
  (if (not l)
      nil
    (if (stringp (car l))
        (concat (car l) (list-to-string (cdr l)))
      (list-to-string (cdr l)))))

(defun join-string (xs &optional sep)
  (cond ((null xs) "")
        ((null (cdr xs)) (car xs))
        (t (concat (car xs) (or sep "") (join-string (cdr xs) sep)))))

(defun string-to-strings (s)
    "Convert a string into a list of strings."
    (let ((i (- (length s) 1)) (l '()))
      (while (<= 0 i)
        (setq l (cons (aref s i) l)
              i (- i 1)))
      (mapcar (lambda (x) (char-to-string x)) l)))

Definição das vogais em português

(setq vn (string-to-strings "aeiouáàéíóúâêôAEIOUÁÀÉÍÓÚÂÊÔ"))
(setq vnc (mapcar (lambda (x) (string-to-char x)) vn))

(defun vowelp (v)
  "É v uma vogal? Sim -> t, Não -> nil. "
  (if (eq () (memq  (string-to-char v) vnc)) nil t))

(defun consonantp (v)
  (if (vowelp v) nil t))

(defun tilde-rm (v)
  "ã -> a~, õ -> o~"
  (cond ((eq  (string-to-char '"ã") (string-to-char v)) "a~")
        ((eq (string-to-char '"õ") (string-to-char v)) "o~")
        (v)))

(defun tilde-rm-string (str)
"Avião Cão-> Avia~o Ca~o"
  (join-string (mapcar (lambda (x) (tilde-rm x)) (string-to-strings str))))

(defun m (str)
  "#CV como está definido no artigo original do Porter"
  (let* ((i 0) (count 0))
    (while (< i (- (length (sts-rm-tnil str)) 1))
      (if (not (eq (nth i (sts-rm-tnil str)) (nth (+ i 1) (sts-rm-tnil str))))
          (setq count (+ 1 count)))
      (setq i (+ i 1)))
    (if (evenp  count) (/ count 2) (/ (+ 1 count) 2))))

(defun R1 (str)
  "Returns R1 part of the word."
  (let*  ((lstr (string-to-strings(tilde-rm-string str))))
    (if (> (length  lstr) 1)
        (if (vowelp (car lstr))
            (if (consonantp (cadr lstr))
                (join-string (cddr lstr))
              (R1 (join-string (cdr lstr))))
          (R1 (join-string (cdr lstr))))
      )))

(defun R2 (str)
  "Returns R1 part of R2."
  (R1 (R1 str)))

(defun RV (str)
  "Retunrs de RV part"
  (let*  ((lstr (string-to-strings(tilde-rm-string str))))
  (cond 
   ((consonantp (cadr lstr ))
    (if (vowelp (caddr lstr))
        (if (consonantp (car (cdddr lstr))) 
            (join-string (cdddr lstr)) (join-string (cddddr lstr)))
      ((and (vowelp (car lstr)) (vowelp (cadr lstr))) 
       (join-string (cdddr lstr)))))
   ((> (length  lstr) 3)  (join-string (cdddr lstr))))))

(defun sort-list-words-length (lstr)
  "Ordena as palavras, numa lista, por ordem decrescente do número de letras."
  (let ((j 0))
    (while (<= j (length lstr))
      (let ((i 0))
        (while (<= i (length lstr))
          (if (< (length (nth i lstr)) (length (nth (+ 1 i) lstr)))
              (swap lstr i (+ 1 i)) nil)
          (setq i (+ 1 i))))
  (setq j (+ 1 j))))
  lstr)

Lista de sufixos

(setq list-suff
      '("eza" "ezas" "ico" "ica" "icos" "icas" "ismo" "ismos" "ável"
	"ível" "ista" "istas" "oso" "osa" "osos" "osas" "amento"
	"amentos" "imento" "imentos" "adora" "ador" "ação" "adoras"
	"adores" "ações" "ante" "antes" "ância"))
(setq list-suff-verbs
     '("ada" "ida" "ia" "aria" "eria" "iria" "ará" "ara" "erá" "era" "irá" "ava" "asse" 
       "esse" "isse" "aste" "este" "iste" "ei" "arei" "erei" "irei" "am" "iam" "ariam" "eriam"
       "iriam" "aram" "eram" "iram" "avam" "em" "arem" "erem" "irem" "assem" "essem" "issem"
       "ado" "ido" "ando" "endo" "indo" "arão" "erão" "irão" "ar" "er" "ir" "as" "adas" "idas"
       "ias" "arias" "erias" "irias" "arás" "aras" "erás" "eras" "irás" "avas" "es" "ardes"
       "erdes" "irdes" "ares" "eres" "ires" "asses" "esses" "isses" "astes" "estes" "istes"
       "is" "ais" "eis" "íeis" "aríeis" "eríeis" "iríeis" "áreis" "areis" "éreis" "ereis" 
       "íreis" "ireis" "ásseis" "ésseis" "ísseis" "áveis" "ados" "idos" "ámos" "amos"
       "íamos" "aríamos" "eríamos" "iríamos" "áramos" "éramos" "íramos" "ávamos" "emos"
       "aremos" "eremos" "iremos" "ássemos" "êssemos" "íssemos" "imos" "armos" "ermos"
       "irmos" "eu" "iu" "ou" "ira" "iras"))
(setq list-res-suff '("os" "a" "i" "o" "á" "í" "ó"))

Alguns testes

(R1 "Aleatoriamente" );"eatoriamente"
(R2 "Aleatoriamente" );"oriamente"
(RV "Aleatoriamente" );"toriamente"

Tags: algoritmo, Porter, Emacs Lisp

2026/02/16-16:01:06

Created: NaN

Last updated: 16-02-2026 [16:03]


For attribution, please cite this page as:

Charters, T., "Sage - diale.org": https://nexp.pt/sgae.html (16-02-2026 [16:03])


(cc-by-sa) Tiago Charters - tiagocharters@nexp.pt